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ABSTRACT 


Silas  B.  Hays  U.S.  Army  Community  Hospital,  Fort  Ord,  California 
has  the  potential  to  lose  over  $900  thousand  in  the  supply  budget 
category  starting  in  fiscal  year  1991.  This  reduction  will  occur  during 
the  conversion  from  a  workload  measiire  based  on  admissions,  births  and 
beds  occupied  (Medical  Care  Composite  Unit,  MCCU)  to  a  Diagnosis 
Related  Group  (DRG)  based  workload  measurement  system.  Title  10, 
Chapter  55  of  the  U.S.  Code,  Section  1101  requires  the  Department  of 
Defense  to  use  DRGs  as  the  primary  criterion  for  allocation  of  medical 
resources. 

The  purpose  of  this  study  is  to  analyze  the  compensation  of  Silas 
B.  Hays  Hospital  under  DRGs.  The  approach  includes  determining 
compensation’s  functional  relationship  to  a  patient’s  gender,  age,  category, 
admitting  service,  length  of  stay,  number  of  diagnoses,  number  of 
procedures,  and  transfer  status,  through  stepwise  multiple  linear 
regression  analysis. 

The  results  of  this  study  showed  the  majority  of  variance  in  case 
mix  can  be  explained  by  length  of  stay.  The  three  most  significant  clinic 
services  were:  (a)  Newborn  nursery,  (b)  Obstetrics,  and  (c)  Family 
Practice  Obstetrics.  Dramatic  changes  in  reimbursement  were  found 
possible  using  peer  group  management  techniques. 

This  study  included  the  development  of  a  software  program  to 
incorporate  the  predictive  capabilities  of  the  stepwise  m\iltiple  linear 
regression  formula  and  the  principles  of  DoD  DRG  reimb\irsement.  The 
program  allows  analysis  of  any  single  or  mxiltiple  change  to  the  case  mix 
of  not  just  Silas  B.  Hays,  but  any  facility  withLa  Health  Services 
Command.  An  import  module  zillows  the  program  to  incorporate  output 
from  the  Retrospective  Case  Mix  Analysis  System  (RCMAS). 


TABLE  OF  CONTENTS 


CHAPTER  PAGE 

I.  INTRODUCTION  . 1 

Conditions  Which  Prompted  the  Study . 1 

Statement  of  the  Management  Problem . 2 

Literature  Review  . 2 

Purpose . : . 9 

II.  METHODS  AND  PROCEDURES  . 10 

Subjects . 10 

Study  Design  . 10 

Data  Collection . 10 

Statistical  Analysis  . 10 

Ethical  Considerations  . 17 

Assumptions . 17 

III.  RESULTS  . 18 

IV.  DISCUSSION . 19 

V.  CONCLUSIONS  AND  RECOMMENDATIONS . 24 

VI.  REFERENCES  . 27 

LIST  OF  TABLES 

Table  1.  Descriptive  Statistics:  Variables  .  30 

Table  2.  Descriptive  Statistics:  Clinic  Services .  31 

Table  3.  Multiple  Regression  Analysis  Formula .  32 

APPENDIX 

A.  DEFINITIONS  AND  ABBREVIATIONS  .  . .  33 

B.  CALCULATION  OF  THE  MEDICAL  WORK  UNIT .  37 

C.  IPDS  AGE  CODES .  41 

D.  IPDS  PATIENT  CATEGORY  CODES .  42 

E.  IPDS  ADMISSION  SOURCE  CODES .  45 

F.  IPDS  DISPOSITION  STATUS  CODES .  46 

G.  MULTIPLE  REGRESSION  ANALYSIS .  47 

H.  PROLOG  SOFTWARE  CODE .  64 

I.  PROLOG  SOFTWARE  PROGRAM  (COLOR) .  Ill 

J.  PROLOG  SOFTWARE  PROGRAM  (LAPTOP)  .  112 


Implementing  DRGs 
1 

CHAPTER  I:  INTRODUCTION 
Conditions  Prompting  This  Study 

Silas  B.  Hays  Army  Community  Hospital  was  scheduled  to  lose 
over  $45  thousand  during  the  fiscal  1989  midyesir  review  according  to 
J.  Jensen  (personal  communication,  April  21,  1989)  representing  the 
Resource  Management  Division  of  Health  Services  Command  (HSC).  This 
reallocation  was  based  on  five  percent  of  the  difference  between  supply 
dollar  amounts  calculated  by  the  old  Medical  Care  Composite  Unit 
(MCCU)  system  and  the  supply  dollar  amo\int  calculated  by  the  new 
congressionally  mandated  Diagnosis  Related  Group  (DRG)  system  (a 
complete  listing  of  definitions  and  abbreviations  are  contained  in 
appendix  A).  Jensen  further  expected  HSC  would  allocate  all  supply 
dollars  by  the  DRG  system  within  two  years  with  a  potential  loss  to  the 
Fort  Ord  hospital  of  over  $900  thousand  compared  to  current  allocation 
methods. 

Past  compensation  measurements  for  resoinxe  allocation  were  based 
on  the  MCCU.  This  system  of  workload  measure  provided  a  large 
emphasis  on  admissions  and  obstetrics  while  encouraging  excessive 
lengths  of  stay.  The  MCCU  is  based  on  the  following  formula: 

Admissions  X  10  + 

Live  Births  X  10  + 

Beds  Occupied  X  1  -f 


Outpatient  Visits  X  0.3 
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The  population  cared  for  and  the  physician  practice  patterns  at 
Silas  B.  Hays  results  in  a  high  level  of  compensation  as  measiuod  by  the 
old  MCCU  methodology.  Unfortunately,  Silas  B.  Hays  had  one  of  the 
lowest  compensation  correlations  between  the  old  MCCU  method  and  the 
new  Department  of  Defense  (DoD)  mandated  DRG  method  (Jensen, 
personal  communication,  April  21,  1989).  This  low  correlation  explains 
one  of  the  highest  projected  negative  supply  dollar  shifts  within  HSC 
medical  treatment  facilities. 

Statement  of  the  Management  Problem 

What  utilization  review  procedures  can  be  implemented  at  Silas  B. 
Hays  Army  Community  Hospital  in  order  to  enhance  compensation  as 
measured  by  the  Department  of  Defense  EHagnosis  Related  Group 
System? 

Literature  Review 

Healthcare  costs  in  1950  stood  at  only  4.6%  of  the  gross  national 
product  (GNP)  (Gibson,  Waldo  &  Levit,  1983).  This  climbed  steadily  to 
7.5%  in  1970  causing  President  Nixon  to  state  that  the  nation  was  facing 
a  "health  care  crisis"  (Ginzberg,  1987).  In  spite  of  this,  the  1982  cost  of 
all  health  services  in  the  United  States  stood  at  10.5%  of  GNP  (Gibson  et 
al.,  1983)  and  has  continued  to  escalate  standing  now  in  excess  of  11% 
(Kimball,  1990). 

The  Military  Health  Services  System  (MHSS)  has  a  cost 
containment  concern  which  parallels  and  even  exceeds  that  of  the  level 
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for  the  United  States  overall.  Total  health  care  costs  for  the  military 
have  seen  a  rise  from  $7.05  billion  in  1983  to  $11.5  Billion  in  1987. 

This  represents  an  annual  growth  in  excess  of  13%  (Soule,  1988) 
compared  to  9.6%  in  1987  for  the  United  States  (Kimball,  1990). 

Cost  containment  in  healthcare  has  been  seen  as  a  priority  by 
healthcare  planners  for  many  years.  However,  all  attempts  to  control 
escalating  healthcare  costs  on  any  wide  scale  basis  before  1983  were 
considered  a  failure  as  there  was  no  incentive  to  ciirb  costs  in  a 
fee-for-service  system  (Dowd,  Johnson,  &  Madson,  1986).  The  most 
important  step  in  this  process  toward  true  cost  containment  was  seen  in 
1983  through  the  promulgation  of  the  prospective  payment  system  for 
Medicare  patients. 

Utilization  Review 

Cost  containment  became  a  high  priority  in  the  face  of  fixed 
payments  for  cases,  as  measured  by  DRGs,  in  the  civilian  healthcare 
arena.  According  to  Feldstein,  Wickizer  &  Wheeler  (1988),  utilization 
review  is  an  effective  mechanism  for  cost  containment.  This  technique 
was  incorporated  by  insurance  companies,  health  maintenance 
organizations,  preferred-provider  organizations  and  other  forms  of 
managed  care  organizations. 

Utilization  review  can  be  traced  back  to  the  Allegheny  County 
Medical  Society.  While  their  efforts  resulted  in  the  Pennsylvania 
Hospital  Utilization  Project,  few  other  facilities  saw  the  need  to  czirry  out 
utilization  review.  Title  XVIII  of  the  Social  Security  Act  (Medicare,  1965) 
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mandated  utilization  review,  but  apathy  continued  (Test  Your  Resource 
Management  I.Q.,  1985). 

The  general  lack  of  physician  support  for  utilization  review  resulted 
in  PL  92-603  in  1972  which  expanded  the  utilization  review  process  to 
include  concurrent  review  of  all  Medicare,  Medicaid,  and  Maternal  and 
Child  Health  Program  admissions.  Professional  Standards  Review 
Organizations  (PSROs)  were  also  formed  by  this  amendment  to  the  Social 
Security  Act.  The  Joint  Commission  on  the  Accreditation  of  Hospitals 
supported  this  emphasis  on  utilization  review  by  separating  the  review 
requirements  into  its  own  standard  (Test  Your  Resoiirce  Management 

I.Q.,  1985). 

Third  party  payers  are  economically  tied  to  the  behavior  of  civilian 
health  care  institutions.  Therefore,  third  party  payers  are  progressively 
influencing  decision  making  by  civilian  health  care  institutions.  A 
primary  mechanism  for  controlling  the  decision  making  of  these 
institutions  is  utilization  review.  According  to  Test  Your  Resource 
Management  I.Q..  (1985)  various  utilization  review  mechanisms  are 
employed  to  control  costs,  these  may  include: 

1.  Pre-admission  authorization  for  elective  admissions. 

2.  Inpatient  concurrent  review  by  outside  reviewing 
agencies. 

3.  Second  opinion  programs. 

4.  Mandatory  use  of  outpatient  settings  for  certain 
surgical  procedures. 
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5.  Capitation  on  costs.  Insurance  companies  will  not  pay 
whatever  price  the  hospital  sets. 

6.  BiU  audits— where  the  medical  record  documentation  is 
compared  to  the  patient’s  bill. 

7.  If  a  physician’s  order  for  the  service  is  not  dociunented, 
the  item  is  not  paid,  (p.10,11) 

The  Department  of  Defense  recognizes  the  merits  fo\ind  in  the 
civilian  sector  for  utilization  review  and  has  issued  Directive  Number 
6025.13  which  states  utilization  review  will  occur  and  have  at  a 
minimvim  the  following  elements: 

1.  Planned  review  of  care  received  by  hospitalized  patients 
with  excessive  lengths  of  stay  for  diagnosis, 
diagnosis-related  groups  (DRG),  or  procedures  as  specified  by 
MTF  [miUtary  treatment  facility]  or  higher  headquarters. 

2.  Review  and  assessment  of  resource  utilization  statistics 

on  accessibility  of  care,  personnel  and  staffing,  and  volume 
of  care  actually  delivered  to  patients. 

3.  Mechanisms  to  evaluate  equipment  maintenance  and 
procurement  policies. 

4.  Policies  on  discharge  planning,  (p.  4) 

According  to  Test  Your  Resource  Management  I.Q..  (1985) 

utilization  review  does  not  prevent  needed  health  care  services,  rather  it 
"enhances  the  delivery  of  those  services  in  order  to  eUminate 
inefficiencies"  (p.  15).  This  conception  is  not  universally  held.  Robinson 
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(1988)  reports  utilization  review  can  lead  to  the  curtailment  of  needed 
services  in  the  name  of  cost  control  alone.  Rohinson  further  reports 
patients  can  often  be  left  with  the  impression  the  care  was  inappropriate 
or  unnecessary  when  utilization  review  is  widespread. 

Utilization  review  can  have  many  advantages  in  enhancing  the 
efficiency  of  inpatient  care.  However,  care  must  always  be  taken  to  be 
sure  any  changes  in  practice  patterns  or  hospital  function  are  in  keeping 
with  sound  quality  assurance  standards. 

Prospective  rate  setting  is  one  of  many  forms  of  reimbursement 
control  methods  which  have  been  tried  in  the  past.  This  method  works 
by  the  external  payer  determining  what  reimbursement  wiU  be  paid  for  a 
specified  unit  of  service  before  the  service  is  performed  (Abe,  1985). 

Fixed  payment  rates  for  each  diagnosis  are  based  on  the  average 
patient.  If  hospitals  can  treat  the  average  patient  below  the  average 
fixed  payment,  then  they  will  make  money  through  a  positive  marginal 
return.  If  the  hospital’s  average  costs  are  above  the  average  fixed 
payment  their  marginal  retxim  will  be  negative.  Therefore,  the  incentive 
for  hospitals  is  to  reduce  costs  in  order  to  have  a  positive  marginal 
return  or  change  behavior  to  maintain  a  higher  reimbursement. 

Diagnosis  Related  Groups 

Original  work  on  prospective  payment  was  performed  by  Thompson, 
Fetter  and  Mross  (1975).  They  erroneously  beheved  hospitals  would 
desire  to  become  efficient  in  order  to  maximize  output.  When  their  work 
was  rejected  by  hospitals,  they  focused  attention  towards  reimburs  jment 
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as  a  means  of  increasing  incentive  (Fetter,  Thompson,  and  Mills,  1976). 
New  Jersey  first  used  DRCJs  to  replace  a  voluntary  rate-setting  program 
(Rosko  &  Broyles,  1987). 

In  1979  the  U.S.  (lovemment  contracted  with  Yale  University  to 
create  a  usable  system  of  DRGs.  The  1981  study  results  became  the 
foundation  for  determining  prospective  payments  for  Medicare  through  PL 
98-21  by  the  Health  Care  Finandug  Administration  (HCFA)  of  Health 
and  Human  Services  (Vladeck,  1984).  Once  embraced  by  HCFA,  the 
system  was  rapidly  adopted  by  many  third  party  payers  including  Blue 
Cross  and  Blue  Shield. 

The  establishment  of  a  particular  DRG  takes  into  account  the 
diagnosis,  procedures  performed  on  the  patient,  the  patient’s  gender,  age 
and  discharge  status.  According  to  Vladeck  (1984)  patients  within  a 
DRG  are  clinically  similar  and  should  have  relatively  uniform  costs 
assodated  with  their  care.  The  relative  weight  assigned  to  each  DRG 
influences  the  payment  for  the  services  provided  by  a  hospital.  This 
reimbursement  is  intended  to  cover  all  ancillary  services  provided  by  the 
hospital  including  radiology,  laboratory  and  nursing  services  (Abe,  1985). 

Department  of  Defense  and  DRGs 

During  the  1980s  Congress  felt  the  cost  of  military  health  care  was 
rising  excessively.  They  pursued  a  legislative  solution  to  this  problem  by 
amendment  to  Title  10  Chapter  55  of  the  U.S.  Code  Section  1101.  This 
amendment  directed  DoD  to  use  DRGs  as  the  primary  criterion  for 
allocation  of  resources  to  MTFs.  Congress  indicated  their  approval  of  a 
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phased  approach  to  resource  allocation  through  DRGs,  but  intended  all 
resources,  including  personnel,  shall  eventually  be  controlled  in  this 
fashion  (Soule,  1988). 

Implementation  gvddance  on  prospective  resource  allocation  in  the 
MHSS  was  given  in  1988  from  then  Assistant  Secretary  of  Defense  for 
Health  Services,  William  Mayer  (1988).  The  first  phase  of 
implementation  would  only  include  the  analysis  of  money  finjm  the 
element  of  resovuxes  for  supphes.  This  phase  was  expected  to  take 
several  years  to  allow  time  for  the  services  adapt. 

A  new  productivity  unit  was  developed  for  DoD  in  order  to  capture 
workload  fi'om  both  in  and  outpatient  work  centers—the  Medical  Work 
Unit  (MWU).  The  MWU  is  composed  of  an  Inpatient  Work  Unit  (IWU) 
as  well  an  Ambulatory  Work  Unit  (AWU).  A  complete  discussion  of  the 
mathematics  for  computation  of  the  MWU  are  contained  in  Appendix  B. 

To  manage  the  new  system  all  military  treatment  facilities  (MTFs) 
were  first  divided  into  Medical  Centers,  CONUS  (located  in  the 
continental  United  Stated),  and  OCONUS  (located  overseas)  hospitals. 

Peer  groups  within  these  categories  based  on  size  and  RCMI  further 
subdivided  the  hospitals.  All  hospitals  started  with  a  base  allocation  rate 
per  MWU  of  $231.04.  In  order  to  more  fully  reflect  true  costs  per  MWU 
each  hospital  within  a  peer  group  was  assigned  a  Resoiirce  Allocation 
Group  (RAG)  additive.  Individual  hospitals  were  further  modified 
through  additional  additives  to  reflect  individual  pharmacy  and  laboratory 
costs  not  otherwise  captured  by  the  system.  The  total  supply  dollar 


Implementing  DRGs 
9 

allocation  for  a  facility  would  be  the  final  supply  allocation  rate 
multiplied  by  the  total  MWUs  for  the  period. 

Dr.  Mayer  recognized  that  each  service  had  unique  reqmrements  for 
the  delivery  of  healthcare  which  made  comparison  between  the  services 
diffioilt.  This  difficulty  led  to  additives  which  would  prevent  the  flow  of 
money  between  services  as  the  result  of  productivity  differences. 

Therefore,  dollars  would  only  flow  between  hospitals  of  the  same  service. 

Purpose 

The  purpose  of  this  study  is  to  analyze  the  compensation  of  Silas  B. 
Hays  U.S.  Army  Community  Hospital  based  on  the  DoD  DRG  system. 

The  approach  includes  the  analysis  of  compensation’s  functional 
relationship  to  a  patient’s  gender,  age,  category,  admitting  service,  length 
of  stay,  number  of  diagnoses,  number  of  procedures,  and  transfer  status. 
For  the  purpose  of  this  study,  compensation  will  be  considered  the  case 
weight  assigned  to  em  inpatient  disposition. 

Healthcare  managers  must  have  available  many  sources  of 
information  in  order  to  make  wise  decisions.  Information  must  include 
all  facts  concerning  resource  consumption  and  compensation  for  every 
patient.  The  analysis  of  compensation  by  this  project  will  assist  in  the 
development  of  an  efficient  utilization  review  system.  The  findings  of 
this  study,  along  with  the  principles  of  case  mix  management,  may  result 
in  the  enhancement  of  resource  allocation  from  HSC  to  this  facility. 
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CHAPTER  II;  METHODS  AND  PROCEDURES 

Subjects 

The  subjects  used  in  this  study  were  all  inpatients  reported  in  the 
IPDS  system  during  calendar  year  1988  at  Silas  B.  Hays  Army 
Community  Hospital,  Fort  Ord,  California.  Those  patients  reported  as 
Carded  For  Record  Only  (i.e.  dead  on  arrival,  stillbirth,  and  medically 
retired)  and  those  treated  totally  Absent  Sick  (i.e.  active  duty  military 
members  who  have  been  admitted  to  civilian  health  care  facilities,  but 
are  kept  on  the  roles  of  an  MTF)  were  excluded  from  the  analysis. 

Study  Design 

This  study  is  an  ex  post  facto  intensive  quantitative  investigation  of 
data  for  eligible  inpatients  treated  at  Silas  B.  Hays  Hospital  during 
calendar  year  1988,  the  latest  complete  year  of  data  available  for 
investigation.  The  results  of  this  large  sample  analysis  are  assximed  to 
be  representative  of  care  given  at  Silas  B.  Hays  Hospital  in  subsequent 
years. 

Data  Collection 

PASBA,  Fort  Sam  Houston,  Texas  collected  the  data  used  in  this 
study.  PASBA  collects  raw  patient  data  from  all  Army  MTFs  and 
performs  needed  statistical  calculation  and  analysis. 

Statistical  Analysis 

This  study  is  built  upon  a  stepwise  multiple  linear  regression 
analysis.  Because  of  the  size  of  the  database  the  regression  was 
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performed  by  PASBA  using  the  Statistical  Package  for  the  Social  Sciences 
(SPSS-X)  Release  3.0  For  IBM  OS/MVS.  The  equation  determines  if  the 
assigned  case  weight  is  a  function  of  the  gender,  age,  category,  admitting 
service,  length  of  stay,  number  of  diagnoses,  number  of  procedures,  and 
transfer  status  for  patients  included  in  the  study. 

Dependent  Variable  (Y) 

CASEWGT  (Case  Weight) 

Independent  Variables  (X) 


MALE 

AGE 

ACTDUTY 

(Active  Duty) 

DACTDUTY 

(Dependents  Of  Active  Duty) 

RETIREE 

(Retirees) 

DRETIREE 

(Dependents  Of  Retirees) 

AA 

(General  Medicine) 

BA 

(General  Surgery) 

BE 

(Oral  Surgery) 

BI 

(Urology) 

CA 

(Gynecology) 

CB 

(Obstetrics) 

DA 

(Pediatrics) 

DB 

(Newborn  Nursery) 

EA 

(Family  Practice  Medicine) 

EC  (Family  Practice  Obstetrics) 
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ED  (Family  Practice  Gynecology) 

EF  (Family  Practice  Pediatrics) 

FA  (Orthopedics) 

FB  (Podiatry) 

GA  (Psychiatry) 

HA  (Ophthalmology) 

HB  (Otorhinolaryngology) 

BEDDAYS  (Length  of  Stay) 

NODIAG  (Number  Of  Diagnoses  Coded) 
NOPROC  (Number  Of  Procedures  Coded) 
TRANSFEN  (Transferred  In) 

TRANSOUT  (Transferred  Out) 


Functional  Relationship 

CASEWGT  =  f(MALE,  AGE,  ACTDUTY,  DACTDUTY,  RETIREE, 
DRETIREE,  AA,  BA,  BE,  BI,  CA,  CB,  DA,  DB,  EA,  EC,  ED,  EF,  FA, 
FB,  GA,  HA,  HB,  BEDDAYS,  NODIAG,  NOPROC,  TRANSFIN, 
TRANSOUT). 


Operational  Definitions 

CASEWGT.  The  weight  of  the  DRG  assigned  to  the  individual  case 
tmder  consideration. 

MALE.  Patient  gender.  Males  coded  1,  females  0. 

AGE.  Defined  as  the  age  in  years.  The  number  0  was  assigned  to 
all  patients  less  than  one  year  of  age.  According  to  R.  Devore  (personal 
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communication,  February  2,  1990)  this  is  the  convention  used  by  PASBA. 
Complete  IPDS  Age  Codes  are  in  Appendix  C. 

ACTDUTY.  Coded  1  for  patients  on  Active  Duty  (patient  categories 
AlO,  FIO,  NIO,  MIO,  CIO,  OlO,  PIO;  all  IPDS  patient  category 
explanations  are  found  in  Appendix  D),  otherwise  0. 

DACTDUTY.  Coded  1  for  patients  who  are  Dependents  of  Active 
Duty  personnel  (patient  categories  A50,  F50,  N50,  M50,  C50,  050,  P50; 
all  IPDS  patient  category  explanations  are  found  in  Appendix  D), 
otherwise  0. 

RETIREE.  Coded  1  for  patients  who  are  Permanently  Retired 
(patient  categories  A30,  F30,  N30,  M30,  C30,  030,  P30;  all  IPDS  patient 
category  explanations  are  found  in  Appendix  D),  otherwise  0. 

DRETIREE.  Coded  1  for  patients  who  are  Dependents  of  Retired 
or  Deceased  personnel  (patient  categories  A60,  F60,  N60,  M60,  C60,  060, 
P60;  all  IPDS  patient  category  explanations  are  found  in  Appendix  D), 
otherwise  0. 

AA.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
General  Medicine,  otherwise  0. 

BA.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
General  Surgery,  otherwise  0. 

BE.  Coded  1  if  the  primary  clinic  service  for  the  patient  was  Oral 
Surgery,  otherwise  0. 

BI.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 


Urology,  otherwise  0. 
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CA.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Gynecology,  otherwise  0. 

CB.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Obstetrics,  otherwise  0. 

DA.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Pediatrics,  otherwise  0. 

DB.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Newborn  Nursery,  otherwise  0. 

EA.  Coded  1  if  the  primary  cHnic  service  for  the  patient  was 
Family  Practice  Medicine,  otherwise  0. 

EC.  Coded  1  if  the  primary  dinic  service  for  the  patient  was 
Family  Practice  Obstetrics,  otherwise  0. 

ED.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Family  Practice  Gynecology,  otherwise  0. 

EF.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Family  Practice  Pediatrics,  otherwise  0. 

FA.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Orthopedics,  otherwise  0, 

FB.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Podiatry,  otherwise  0. 

GA.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Psychiatry,  otherwise  0. 

HA.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 


Ophthalmology,  otherwise  0. 
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HB.  Coded  1  if  the  primary  clinic  service  for  the  patient  was 
Otorhinolaryngology,  otherwise  0. 

BEDDAYS.  Total  bed  and  bassinet  days;  henceforth  referred  to  as 
Average  Length  of  Stay  (ALOS). 

NODIAG.  Number  of  diagnoses  coded  in  the  IPDS  record  (values  1 
to  8).  Actual  patient  medical  record  may  have  more  than  8  diagnoses 
listed. 

NOPROC.  Number  of  procedures  coded  in  the  IPDS  record  (values 
0  to  8).  Actual  patient  medical  record  may  have  more  than  8  procedures 
listed. 

TRANSFIN.  Coded  1  for  those  cases  transferred  into  Fort  Ord 
from  another  facihty  (admission  source  5,  6,  7,  8,  9,  or  0),  otherwise  0. 
Appendix  E  lists  IPDS  admission  source  codes  with  definitions. 

TRANSOUT.  Coded  1  for  those  cases  transferred  out  to  another 
facility  (disposition  status  S,  T,  or  U),  otherwise  0.  Appendix  F  lists 
IPDS  disposition  status  codes  with  definitions. 

In  order  to  allow  for  degrees  of  freedom,  only  those  clinic  services 
representing  greater  than  0.5%  of  the  cases  were  included  in  the 
analysis.  All  clinics  below  the  0.5%  threshold  were  all  coded  0; 
therefore,  only  those  clinics  which  reported  admissions  were  included  for 
consideration  in  this  analysis.  Those  patients  not  belonging  to  the  listed 
IPDS  patient  categories  were  considered  "other"  if  all  four  listed  patient 
categories  were  coded  0. 
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Validity 

As  the  military  has  been  mandated  by  Congress  to  comply  with  the 
distribution  of  resources  based  on  Diagnosis  Related  Management,  a 
special  type  of  face  validity  can  be  presumed.  About  50%  of  the 
variation  in  length  of  stay  within  a  particular  DRG  has  been  explained, 
the  other  50%  is  presumed  to  be  due  to  disease  severity  variation 
(Coventry,  1988). 

Reliability 

There  are  three  significant  sources  of  error  for  the  DRG  system  as 
foimd  in  the  data  base  at  PASBA:  (a)  physician  errors  in  not  following 
the  definition  for  the  principal  diagnosis,  secondary  diagnosis  or  surgical 
procedure;  (b)  coding  errors  by  patient  administration  staff  transposing  of 
code  numbers,  not  following  conventions  or  guidelines,  or  simply 
misinterpreting  information;  and  lastly  (c)  keying  of  information  into 
computer  terminals  (Ashcraft,  1986). 

Null  Hypothesis 

No  linear  relationship  exists  between  the  dependent  variable  case 
weight  and  the  independent  variables  for  gender,  age,  IPDS  patient 
category,  clinic  service,  beddays,  number  of  diagnoses,  number  of 
procedures,  whether  the  patient  was  transferred  in,  or  transferred  out. 
Alternate  Hypothesis 

Case  weight  is  a  function  of  gender,  age,  IPDS  patient  category, 
clinic  service,  beddays,  number  of  diagnoses,  number  of  procedures, 
whether  the  patient  was  transferred  in,  or  transferred  out. 
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Alpha  Level 

A  confidence  level  of  0.05  was  \ised  to  determine  if  the  next 
independent  variable  would  be  in  the  stepwise  multiple  linear  regression 
equation. 

Ethical  Considerations 

All  data  in  this  study  was  provided  by  the  PASBA  services  located 
at  Fort  Sam  Houston,  Texas.  At  no  time  was  patient  information 
reported  which  would  allow  disclosure  of  an  individual  patient’s  identity. 
Any  reports  obtained  fi-om  PASBA  containing  information  traceable  to 
individual  patients  were  shredded  following  analysis.  Patient  anonymity 
was  preserved  throughout  all  phases  of  this  study.  Therefore,  no 
individual’s  ethical  rights  were  violated. 

Assumptions 

DoD  and  HSC  are  in  an  unstable  environment  regarding  resoiirce 
allocation  imder  the  DRG  based  methodology.  Full  evaluation  of  the 
merits  of  the  current  implementation  strategy  are  imder  evaluation  by  a 
contractor  (Vector  Research)  according  to  J.  Jensen  (personal 
communication,  January  3,  1990).  The  results  of  the  analysis  by  the 
contractor  are  expected  during  the  month  of  June  or  July  1990. 
Therefore,  I  made  the  assumption  the  implementation  strategy  for  DRGs 
will  follow  the  principles  outlined  in  the  August  5,  1988  memorandum 
firom  then  Assistant  Secretary  of  Defense  for  Health  Affairs  William 
Mayer  (1988). 
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CHAPTER  III:  RESULTS 

A  total  of  10,496  records  were  analyzed.  Appendix  G  gives  a 
complete  listing  of  all  steps  of  the  stepwise  multiple  linear  regression 
analysis.  Table  1  displays  descriptive  statistics  of  all  variables  used  in 


Insert  Table  1  here 


the  regression  equation.  More  females  were  treated  than  males.  The 
average  age  of  patients  was  approximately  27  years.  Dependents  of 
active  duty  comprised  over  50%  of  the  patient  population  treated  followed 
by  active  duty  with  approximately  27%. 

Table  2  gives  more  detail  on  the  clinic  service  variables. 


Insert  Table  2  here 


Obstetrics,  Internal  Medicine  and  Newborn  Nursery  together  provided 
care  to  over  40%  of  the  patients  admitted  to  Silas  B.  Hays  Hospital.  The 
top  producer  of  RWPS  was  Internal  Medicine  with  General  Surgery  next. 
The  service  producing  the  highest  average  CMI  was  Psychiatry.  Of 
interest  is  while  the  number  of  RWPS  produced  by  General  Medicine  and 
Obstetrics  was  similar.  Obstetrics  required  more  than  500  additional 
patients  to  produce  those  RWPS,  a  reflection  of  the  low  average  CMI  for 
patients  treated  by  the  Obstetrical  Service.  The  average  patient  treated 
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in  the  Newborn  Nursery  had  a  CMI  of  0.2080,  the  lowest  CMI  of  any 
service. 

Table  3  presents  the  complete  stepwise  miiltiple  linear  regression 


Insert  Table  3  here 


analysis  formula  prepared  for  this  project.  Seventeen  variables  met  the 
0.05  confidence  level  and  were  therefore  included  in  the  equation  for 
predicting  case  weight.  Twelve  variables  not  meeting  the  criteria  for 
inclusion  are  found  on  the  last  page  of  Appendix  G. 

CHAPTER  IV:  DISCUSSION 

Nearly  73%  of  the  variance  in  case  weight  between  patient 
dispositions  can  be  explained  when  using  the  variables  having  a 
significance  of  0.05  or  greater  (Table  3).  The  majority  of  variance  (62%) 
can  be  accounted  for  by  length  of  stay.  The  importance  of  length  of  stay 
is  not  surprising  when  the  formula  for  calculating  the  assigned  case 
weight,  or  RWP  is  examined  (Appendix  B).  The  next  foxu:  variables 
showing  the  most  influence  on  case  weight  variance  were  (a)  age, 
followed  by  the  three  clinic  services  of  (b)  Newborn  Nursery,  (c) 
Obstetrics,  and  (d)  Family  Practice  Obstetrics. 

When  evaluating  the  influence  of  the  significant  variables,  it  is 
important  to  look  not  just  at  the  magnitude  of  influence,  but  also  the 
direction  of  influence.  As  expected,  length  of  stay  and  age  have  a 
positive  influence,  although  the  magnitude  of  the  influence  of  age  was 
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surprisingly  small.  Of  note  is  the  negative  influence  of  the  first  three 
services  of  the  equation  on  case  mix.  The  negative  effect  on  case  mix  of 
a  patient  being  newborn  is  only  exceeded  if  a  patient  is  a  transfer  into 
the  facility. 

The  excellent  predictive  capabilities  of  regression  analysis  must  be 
tempered  with  use  of  reasonable  variable  changes.  For  example,  while 
transferring  a  patient  into  Silas  B.  Hays  provides  a  strong  negative 
influence  on  a  predicted  case  mix,  it  can  be  expected  to  occiu* 
infrequently  (only  0.4%  of  admissions  in  1988,  Table  1).  On  the  other 
hand,  three  of  the  top  four  DRGs  recorded  during  1988:  (a)  391,  Normal 
Newborn;  (b)  373,  Vaginal  Delivery  Without  Comorbidities  or 
Complications;  and  (c)  383,  Other  Antepartum  Diagnoses  With 
Comorbidities  and/or  Complications  represented  2,423  patient  dispositions, 
or  over  23%  of  the  total  for  the  year.  Therefore,  it  would  be  more 
reasonable  to  make  a  large  change  in  one  of  the  top  three  volume 
variables  than  in  the  smaller  variable. 

Twelve  variables  failed  to  influence  the  case  mix  of  a  patient  at  the 
0.05  level  of  confidence.  Several  of  these  variables  deserve  comment. 
Gynecology  is  an  alternate  emphasis  for  the  obstetrician/gynecologist. 
However,  an  increase  in  volume  could  not  be  depended  upon  to  produce  a 
significant  change  in  case  mix.  While  Psychiatry  had  the  highest  mean 
for  CMI,  the  predictive  qualities  for  the  service  were  poor.  The  four 
IPDS  patient  categories  were  expected  to  coiTelate  with  age  and  therefore 
show  a  higher  level  of  significance,  but  did  not. 
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A  double  swing  in  the  volume  of  patients  falling  into  the  top  three 
clinic  services  noted  has  occurred  over  the  past  ten  years  at  Silas  B. 

Hays  Hospital.  An  active  midwifery  program  phase  out  in  the  mid  1980s 
along  with  a  nursing  and  obstetrician  shortage  resulted  in  a  dramatic 
parallel  drop  in  admissions  to  the  obstetrical  service  and  newborn 
nursery.  While  this  drop  vaulted  the  RCMI  of  the  facihty  over  0.900  it 
had  a  violent  affect  on  the  distribution  of  funds  from  HSC.  As 
previously  discussed,  the  MCCU  methodology  of  resource  allocation  richly 
rewards  obstetrical  care  and  ignores  case  mix.  The  current  leadership  of 
Silas  B.  Hays  noted  the  trend  in  reimbursement  and  moved  quickly  to 
reverse  the  outflow  of  obstetrical  care  to  the  advance  of  reimbiirsement 
but  the  detriment  of  RCMI.  The  current  RCMI  for  Silas  B.  Hays 
Hospital  now  hovers  slightly  over  0.8200. 

The  concept  of  case  mix  is  important  only  when  reimbursement  is 
calculated  by  the  DRG  system.  As  explained  in  Appendix  B,  the  IWU  is 
calcxilated  by  multiplying  MEPRS  dispositions  by  tbe  RCMI  of  the 
facility.  Therefore,  case  mix  strongly  influences  reimbursement  under  the 
DRG  system. 

Reimbursement  depends  not  just  on  the  number  of  MWUs,  but  also 
on  the  final  supply  allocation  rate.  Silas  B.  Hays  falls  into  the  general 
category  of  a  CONUS,  Non-teaching  Hospital.  This  general  category  is 
further  subdivided  into  eight  peer  groups,  each  determined  by  size  and 
RCMI.  With  a  size  greater  than  100  beds,  SUas  B.  Hays  can  be  in  only 
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one  of  two  peer  groups.  These  two  groups  are  separated  into  those 
facilities  having  an  RCMI  of  over  0.900  and  those  having  a  lower  RCMI. 

The  important  difference  between  the  two  peer  groups  available  for 
Silas  B.  Hays  is  the  presence  of  a  RAG  additive  of  $43.64  for  the  higher 
RCMI  peer  group.  The  RAG  additive  alone  represents  over  an  eighteen 
percent  difference  between  the  two  peer  groups.  During  the  period  Silas 
B.  Hays  shunned  obstetrical  care,  it  woxild  have  occupied  the  higher  peer 
group.  Silas  B.  Hays  currently  qualifies  for  the  lower  group. 

Sixty  percent  of  the  MWUs  at  Silas  B.  Hays  are  earned  through 
AWUs.  Therefore,  40%  of  the  workload  influences  the  reimbursement  for 
all  of  the  workload.  While  the  composition  of  inpatient  workload  is 
expected  to  influence  outpatient  workload  the  significance  is  uncertain. 

Of  note  is  that  an  ambulatory  visit  under  the  DRG  system  is  weighted 
heavier  for  an  obstetrical  than  a  gynecological  visit  (0.0260  vs.  0.0236),  a 
negative  correlation  between  inpatient  and  outpatient  reimbursement. 

Two  facilities  with  identical  outpatient  popiilations  and  workload  could  be 
resourced  differently  for  workload  solely  due  to  the  reimbursement  rate 
determined  by  inpatient  care. 

Prolog  Computer  Software  Program 

In  order  to  operationalize  the  results  of  this  study  a  software 
program  entitled  "The  Diagnosis  Related  Group  (DRG)  Based  Methodology 
Transition  Impact  Program"  which  incorporates  the  predictive  capabilities 
of  the  multiple  regression  formula  and  the  principles  of  DoD  DRG 
reimbursement  was  developed.  The  programming  language  chosen  for 
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the  program  was  Borland  International  Turbo  Prolog  Version  2.0,  the 
language  of  artificial  intelligence.  A  complete  listing  of  code  for  this 
program  is  contained  in  Appendix  H.  The  software  is  in  Appendix  I  for 
color  and  Appendix  J  for  Laptop  computers. 

The  incentive  for  producing  this  program  was  the  need  to 
understand  the  economic  impact  of  making  case  mix  changes  in  the 
facility.  Computer  modeling  was  the  logical  method,  first  with  a  simple 
spreadsheet  showing  how  single  DRG  changes  affected  reimbursement. 
Later,  as  insight  grew  the  need  was  apparent  for  a  model  which  would 
make  multiple  simultaneous  changes  in  case  mix. 

The  Prolog  software  program  allows  analysis  of  any  single  or 
multiple  change  to  the  case  mix  of  not  just  Silas  B.  Hays,  but  any 
facility  within  HSC.  It  incorporates  database  workload  information  from 
any  HSC  hospital  and  all  473  DoD  DRGs.  An  import  module  enables 
the  program  to  incorporate  output  fix)m  the  Retrospective  Case  Mix 
Analysis  System  (RCMAS),  thereby  allowing  analysis  of  actual  workload 
data.  Modeling  of  case  mix  change  impact  can  be  done  either  through 
analysis  of  individual  or  group  DRG  changes  or  through  mass  changes  in 
the  variables  of  the  linear  regression  form\ila  developed  for  this  project. 
The  regression  formula  is  currently  available  only  for  Silas  B.  Hays 
workload  but  could  be  performed  by  PASBA  for  any  other  faciUty  through 
minor  program  changes. 

Case  mix  modeling  with  the  software  brought  many  expected,  but 
some  unexpected  findings.  As  a  general  rule,  every  additional  inpatient 
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disposition  resulted  in  some  reimbursement,  though  the  effect  on  RCMI 
may  be  negative.  Conversely,  not  admitting  patients  had  a  deleterious 
effect  on  reimbursement  in  almost  all  cases. 

As  previously  noted,  over  23%  of  patient  dispositions  from  Silas  B. 
Hays  were  handled  by  the  services  having  the  most  significant  negative 
effect  on  case  weight  for  a  disposition.  The  Diagnosis  Related  Group 
(DRG)  Based  Methodology  Transition  Impact  Program  indicates  that 
eliminating  care  for  these  patients  would  result  in  an  increased  inpatient 
reimbursement  for  Silas  B.  Hays  under  the  DRG  system  over  the  MCCU 
system  of  $143,797  in  supply  dollars  alone!  This  qviirk  in  reimbvirsement 
is  the  result  of  a  dramatic  rise  in  the  RCMI  to  break  the  0.9000 
threshold,  thus  increasing  reimbursement  by  over  $43  per  IWU. 

CHAPTER  V: 

CONCLUSIONS  AND  RECOMMENDATIONS 

The  scope  of  this  project  was  limited  with  the  decision  to  deal 
strictly  with  variables  as  they  relate  to  reimbursement  and  not  as  they 
relate  to  cost.  This  was  not  to  devalue  cost  analysis.  Dr.  Finstein 
(personal  communication,  July  11,  1988)  stated  the  use  of  statistics  has 
four  stages;  (a)  First  you  describe  phenomena,  then  (b)  you  explain,  (c) 
predict,  and  finally  (d)  control.  My  attempt  with  this  research  was  to 
produce  a  foundation  of  information  on  those  variables  at  Silas  B.  Hays 
Hospital  which  has  a  significant  influence  on  case  mix.  Future  research 
must  deal  with  cost  analysis  in  order  to  better  evaluate  efficiency  of 


Implementing  DRGs 
25 

healthcare  delivery.  A  refinement  of  the  MEPRS  system  is  strongly 
recommended  in  order  to  track  cost  to  individual  patients  and  providers. 

The  military  healthcare  system  functions  essentially  as  a 
not-for-profit  organization.  However,  not-for-profit  organizations  must  be 
concerned  with  reimbursement  or  risk  of  not  being  able  to  provide  care. 
Military  healthcare  managers  have  adapted  their  organizations  to  the  old 
MCCU  resourcing  system,  fi:«quently  shaping  the  case  mix  as  did  Silas  B. 
Hays,  to  receive  resources  adequate  for  delivering  healthcare  the  mission 
demands. 

Costs  must  be  balanced  with  reimbursements  for  survival,  even  in 
the  mihtary  health  care  system.  To  radically  reduce  funding  to  Silas  B. 
Hays  or  any  other  MTF  is  a  mandate  to  the  hospital  to  change  its 
mission.  Intention  for  change  is  a  separate  issue.  A  system  which  will 
give  economic  incentive  to  not  take  care  of  patients,  as  would  be  the  case 
for  obstetrical  patients  at  Silas  B.  Hays,  is  a  system  fundamentally 
flawed. 

Only  two  alternatives  exist  for  an  MTF  in  the  presence  of  an 
underfunded  medical  mission:  (a)  Deliver  the  services  by  cost  shifting 
from  overfunded  missions,  or  (b)  provide  an  alternative  means  of 
delivering  the  services  with  funding  external  to  the  hospital  budget.  If  a 
medical  mission  is  essential  for  a  military  hospital  then  it  should  be 
funded  accordingly.  Ignoring  the  effects  of  economic  incentive  for  military 
healthcare  managers  is  to  ignore  reality. 
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Effective  utilization  review  requires  precise  information  on 
availability  of  resources  for  delivering  healthcare.  This  study  provides  a 
foundation  of  information  upon  which  a  better  understanding  of 
healthcare  delivery  decisions  can  be  made. 

The  software  developed  will  be  best  used  in  making  decisions  on 
inpatient  versus  outpatient  care  for  many  categories  of  patients. 
Additionall>,  categories  such  as  obstetrical  patients  will  come  imder 
serious  evaluation  on  the  financial  risk  of  providing  direct  care  versus 
finding  alternative  means  of  healthcare  deliver. 

The  recommendations  of  the  Vector  Research  analysis  and  resultant 
implementing  instructions  will  set  the  iiltimate  course  for  the  behavior  of 
Silas  B.  Hays.  Weiner,  Maxwell,  Sapolsky,  Dunn  and  Hsiao  (1987)  state 
decision  making  in  health  care  normally  lies  in  the  hands  of  clinicians, 
not  health  care  administrators.  These  authors  state  decision  making 
power  comes  fix)m  the  area  of  responsibility  having  the  greater 
uncertainty  associated  with  it,  emd  issues  in  medicine  are  typically  more 
uncertain  than  those  in  administration.  However,  the  threat  of  a  near 
one  million  dollar  shift  in  supply  dollars  and  the  risk  of  future  resource 
losses  will  create  a  temporary  shift  in  power.  A  clinician-administrator 
coalition  will  form  to  make  significant  practice  pattern  changes  at  Silas 
B.  Hays  Hospital.  These  changes  will  occur  under  the  realm  of 
utilization  review  and  will  reestablish  the  balance  in  uncertainty  away 
firom  fiscal  issues  back  to  clinical  issues. 
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Table  1 


Descriptive  Statistics:  Variables 


Label 

Mean 

Std  Dev 

Cases 

Variable  Label 

MALE 

0.462 

0.499 

4,850 

AGE 

ACTDUTY 

27.242 

0.269 

21.556 

0.444 

2,827 

ACTIVE  DUTY 

DACTDUTY 

0.5140 

.500 

5,392 

DEP  OF  ACTIVE  DUTY 

RETIREE 

0.1110 

.314 

1,160 

RETIREES 

DRETIREE 

0.089 

0.284 

929 

DEP  OP  RETIREES 

*  OTPATCAT 

0.018 

0.133 

188 

OTHER  PATIENT  CATEGORIES 

AA 

0.141 

0.348 

1,481 

GENERAL  MEDICINE 

*  AB 

0.000 

0.017 

3 

CARDIOLOGY 

*  AF 

0.000 

0.010 

1 

GASTROENTEROLOGY 

*  AI 

0.000 

0.010 

1 

NEPHROLOGY 

*  AJ 

0.000 

0.010 

1 

NEUROLOGY 

BA 

0.105 

0.307 

1,105 

GENERAL  SURGERY 

BE 

0.030 

0.170 

313 

ORAL  SURGERY 

*  BF 

0.002 

0.039 

16 

PEDIATRIC  SURGERY 

BI 

0.049 

0.215 

510 

UROLOGY 

CA 

0.029 

0.167 

301 

GYN 

CB 

0.154 

0.361 

1,615 

OB 

DA 

0.068 

0.251 

712 

PEDIATRICS 

DB 

0.123 

0.329 

1,292 

NEWBORN  NURSERY 

EA 

0.039 

0.193 

407 

FP  MEDICINE 

*  EB 

0.002 

0.047 

23 

FP  SURGERY 

EC 

0.089 

0.284 

931 

FP  OB 

ED 

0.006 

0.075 

60 

FP  GYN 

EF 

0.019 

0.135 

195 

FP  PEDIATRICS 

*  EG 

0.001 

0.029 

9 

FP  ORTHOPEDICS 

FA 

0.066 

0.248 

692 

ORTHOPEDICS 

FB 

0.010 

0.101 

108 

PODIATRY 

GA 

0.039 

0.193 

407 

PSYCHIATRY 

HA 

0.010 

0.098 

102 

OPHTHALMOLOGY 

HB 

0.020 

0.140 

211 

ENT 

BEDDAYS 

3.635 

5.762 

NUMBER  OF  BED  DAYS 

NODIAG 

2.109 

1.537 

NUMBER  OF  DIAGNOSIS 

NOPROC 

1.266 

1.346 

CODED 

NUMBER  OF  PROCEDURES 

CASEWGT 

0.667 

0.657 

CODED 

CASE  WEIGHT 

TRANSFIN 

0.004 

0.062 

41 

TRANSFERRED  IN 

TRANSOUT 

0.029 

0.168 

305 

TRANSFERRED  OUT 

*  Note.  Variable  not  used  in  the  analysis  as  significance  less  than  the  0.05 
confidence  level. 
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TABLE  2 


Descriptive  Statistics:  Clinic  Services 


Clinic  Service 

Code 

DISP 

%  of 
DISP 

CMI 

Total 

RWP 

%  of 
RWPS 

Internal  Medicine 

AA 

1481 

14.11% 

0.8897 

1317.6457 

18.81% 

Cardiology 

AB 

3 

0.03% 

0.6402 

1.9206 

0.03% 

Gastroenterology 

AF 

1 

0.01% 

0.5574 

0.5574 

0.01% 

Nephrology 

AI 

1 

0.01% 

0.6032 

0.6032 

0.01% 

Neurology 

AJ 

1 

0.01% 

0.7658 

0.7658 

0.01% 

General  Siirgery 

BA 

1105 

10.53% 

0.9244 

1021.4620 

14.58% 

Oral  Surgery 

BE 

313 

2.98% 

0.5733 

179.4429 

2.56% 

Pediatric  Surgery 

BF 

16 

0.15% 

0.7572 

12.1152 

0.17% 

Urology 

BI 

510 

4.86% 

0.6570 

335.0700 

4.78% 

Gynecology 

CA 

301 

2.87% 

0.7592 

228.5192 

3.26% 

Obstetrics 

CB 

1615 

15.39% 

0.5864 

947.0360 

13.52% 

Pediatrics 

DA 

712 

6.78% 

0.5709 

406.4808 

5.80% 

Newborn  Nursery 

DB 

1292 

12.31% 

0.2080 

268.7360 

3.84% 

FP-Medical 

EA 

407 

3.88% 

0.9053 

368.4571 

5.26% 

FP-Surgical 

EB 

23 

0.22% 

0.6741 

15.5043 

0.22% 

FP-Obstetrics 

EC 

931 

8.87% 

0.5353 

498.3643 

7.11% 

FP-Gynecology 

ED 

60 

0.57% 

0.6576 

39.4560 

0.56% 

FP-Pediatrics 

EF 

195 

1.86% 

0.4925 

96.0375 

1.37% 

FP-Orthopedics 

EG 

9 

0.09% 

0.7819 

7.0371 

0.10% 

Orthopedics 

FA 

692 

6.59% 

0.8490 

587.5080 

8.39% 

Podiatry 

FB 

108 

1.03% 

0.8970 

96.8976 

1.38% 

Psychiatry 

GA 

407 

3.88% 

1.0140 

412.6980 

5.89% 

Ophthalmology 

HA 

102 

0.97% 

0.5730 

58.4460 

0.83% 

Otorhinolaryngology 

HB 

211 

2.01% 

0.4915 

103.7065 

1.48% 

Grand  Total 

10496 

100.00% 

0.6673 

7004.4672 

100.00% 

Note. 

DISP  -  Dispositions 

CMI  -  Case  Mix  Index  (Total  RWP  divided  by  No  of  Dspo) 

RWPS  -  Relative  Weighted  Product  (Weight  of  an  individual  case) 
Total  RWPS  -  Total  of  RWPs  for  all  the  cases  for  the  given  clinic 
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TABLE  3 


CASEWGT  =  (.086193)  X 

+  (.003122)  X 

+  (-.323502)  X 

+  (-.134777)  X 

+  (-.155038)  X 

+  (.028401)  X 

+  (-.558463)  X 

+  (.179117)  X 

+  (.147480)  X 

+  (.020133)  X 

+  (-.124597)  X 

+  (.162995)  X 

+  (.070846)  X 

+  (.081358)  X 

+  (.086141)  X 

+  (.052370)  X 

+  (.015908)  X 

+  (.215037) 


(number  of  Bed  days) 

(Age  of  Patient) 

(1  if  Clinic  Service  is  DB) 

(1  if  Clinic  Service  is  CB) 

(1  if  Clinic  Service  is  EC) 
(Number  of  Procedures  coded) 

(1  if  Patient  was  transferred  in) 
(1  if  Clinic  Service  is  FA) 

(1  if  Clinic  Service  is  BA) 
(Nxunber  of  Diagnoses  coded) 

(1  if  Patient  was  transferred  out) 
(1  if  Clinic  Service  is  FB) 

(1  if  Clinic  Service  is  AA) 

(1  if  Clinic  Service  is  EA) 

(1  if  Clinic  Service  is  BE) 

(1  if  Clinic  Service  is  DA) 

(1  if  Patient  was  male) 

Constant 
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Appendix  A 

Abbreviations  and  Definitions 

ALOS  Average  Length  of  Stay  —  The  average  length  of  hospitalization 
of  inpatients  discharged  duiing  the  period  vmder  consideration, 

AWU  Ambulatory  Work  Unit  --  An  outpatient  workload  credit 
measurement.  AWU  weights  and  methodology  are  published  in 
Report  HR  88-001  (April  1988),  "Military  Health  Services  System 
Ambulatory  Work  Unit". 

CMI  Case  Mix  Index  --  Total  RWPs  for  an  MTF  divided  by  the  total 
of  biometrics  dispositions  through  the  individualized  Patient  Data 
System  (IPDS)  for  which  the  RWPs  were  determined.  DRG  469 
(Primary  Diagnosis  Invalid  as  a  Discharge  Diagnosis)  and  DRG 
470  (Ungroupable)  are  excluded  from  the  calculations  since  their 
relative  weights  are  zero.  The  CMI  gives  the  number  of  RWPs 
generated  by  the  average  dispositions  from  the  MTF. 

Disposition  -  The  termination  of  a  period  of  inpatient  hospitalization 
through  the  formal  release  of  the  inpatient  by  the  hospital. 

DRG  Diagnosis  Related  Group  --  classification  of  patients  by 
demographic  and  diagnostic  variables  into  clinically  comparable 
groups  with  similar  lengths  of  stay  and  intensity  of  resource 
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Appendix  A  (cont’d) 

consumption.  The  DRG  system  has  been  adopted  as  the  basis  to 
credit  workload  and  allocate  resources  within  DoD  MHSS. 

DRG  Assignment  -  The  five  essential  elements  required  before  a  DRG  can 
be  assigned  are:  1)  principal  diagnosis  (and  complications/ 
comorbidities);  2)  principal  procediue;  3)  patient’s  age;  4)  patient’s 
sex;  and  5)  discharge  status. 

DRG  WEIGHT  (Relative  Weight)  —  An  index  niunber  which  reflects  the 
relative  resoimce  consumption  associated  with  each  DRG. 

DoD  CMI  (FY  85)  -  Average  RWPs  per  disposition  across  DoD  for  FY  85. 

Total  DoD  RWPs  for  the  base  year  (FY85)  were  776,023.  Total 
dispositions  from  biometrics  data  (less  DRGs  469  and  470)  were 
957,901.  The  DoD  CMI  for  the  base  year  is  then  equal  to 
776,023/957,901  or  0.8101.  This  factor  is  used  to  adjust  all 
subsequent  case  mix  calculations  to  the  DoD  average  for  the  base 
year. 

rWU  Inpatient  Work  Unit  -  The  workload  credit  given  each  MTF 
disposition.  Total  IWUs  for  a  MTF  are  calculated  by  multiplying 
a  MTFs  total  MEPRS  dispositions  by  their  RCMI.  Since  there 
is  often  a  discrepancy  between  biometrics  and  MEPRS 
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MHSS 


RCMI 


RWP 


Appendix  A  (cont’d) 

dispositions,  the  official  volume  count  fiom  MEPRS  is  used.  This 
process  makes  the  assumption  that  any  dispositions  counted  in 
MEPRS  but  not  available  through  biometrics  for  DRG  assignment 
follow  the  same  case  mix  distribution  as  those  dispositions  which 
have  been  assigned  to  DRGs. 

Military  Health  Services  System  --  This  system  contains 
biometrics  data  from  the  Army,  Navy,  and  Air  Force. 

Relative  Case  Mix  Index  -  The  mihtary  treatment  facilities  (MTF) 
CMI  divided  by  the  FY  85  DoD  CMI.  This  calculation 
standardizes  workload  credit  such  that  the  average  discharge 
across  all  of  DoD  receives  a  workload  credit  of  1.00.  For  a  given 
MTF,  an  RCMI  of  1.35  indicates  that  based  on  a  case  mix  alone, 
the  MTFs  disposition  should  be  35%  more  resource  intense  than 
the  DoD  average,  everything  else  being  equal.  Late  records  will 
impact  on  a  hospital’s  CMI. 

Relative  Weighted  Products  --  Dispositions  from 
biometrics  weighted  by  the  MHSS  relative  cost  weights.  Each 
disposition  from  the  Services’  biometrics  system  is  assigned  to  a 
DRG  and  weighted  by  the  appropriate  MHSS  weight  for 
that  DRG  in  accordance  with  the  rules  for  handling  short  and 
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Appendix  A  (cont’d) 

long  stay  outliers  and  transfer  cases.  The  sum  of  weighted 
dispositions  for  a  Military  Treatment  Facility  (MTF)  is  the  total 
RWPs  for  that  MTF. 


Note. 

Definitions  and  abbreviations  are  extracted  from  the  multiple 
reports  available  from  the  U.S.  Army,  Health  Services  Command’s 
Patient  Administration  Systems  and  Biostatistics  Activity  (PASBA) 
office  and  from  Mayer  (1988). 
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Appendix  B 

Calculation  of  the  Medical  Work  Unit 
Sample  Calculation 

DRG  198  TOTAL  CHOLECYSTECTOMY  W/0  C.D.E.  AGE  <  70  W/0  C.C. 

CHAMPUS  WEIGHT  =  1.0987 

GEOMETRIC  MEAN  LENGTH  OF  STAY  (LOS)  =  5.8  DAYS 
SHORT  STAY  CUTOFF  =  4  DAYS  LONG  STAY  CUTOFF  =  10  DAYS 
Per  Diem  =  CHAMPUS  Weight/Geometric  Mean  LOS  =  1.0987/5.8  =  0.1894 

Calculating  RWPS 

1.  If  LOS  <  Short  Stay  Cutoff  and  patient  transferred  out: 

RWPS  =  Dispositions  X  LOS  X  Per  Diem 

e.g.  Two  dispositions  =2X2  Days  X  0.1894  =  0.3788  RWPS 

2.  If  LOS  <  Short  Stay  Cutoff  and  patient  not  transferred: 

RWPS  =  Dispositions  X  LOS  X  Per  Diem  X  200% 

e.g.  two  dispositions  =  2X2  Days  X  0.1894  X  2  =  0.7576  RWPS 

3.  If  LOS  >  Short  Stay  Cutoff  and  <  Long  Stay  Cutoff: 

RWPS  =  Dispositions  X  CHAMPUS  Weight 

e.g.  15  dispositions  =  15  X  1.0987  =  16.4805  RWPS 

4.  If  LOS  >  Long  Stay  Cutoff; 

RWPS  =  Dispositions  X  CHAMPUS  Weight  +  Dispositions  X  60%  X  CHAMPUS 
Weight 


e.g.  one  disposition  with  LOS  of  12  days 

1  X  1.0987  +  (0.6  X  1.0987  X  2)  =  1.3259  RWPS 
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Appendix  B  (cont’d) 


MTF  WITH  20  PATIENTS  IN  DRG  198: 


DAYS 

CALCULATIONS 

RWPS 

2  (transferred  to  MEDCEN) 

2  X  0.1894  = 

0.3788 

2 

2  X  0.3788  = 

0.7576 

3 

3  X  0.3788  = 

1.1364 

4,  4,  5,  6,  6,  6,  6,  6, 

6,  7,  7,  7,  8,  9,  9 

15  X  1.0987  = 

16.4805 

12 

1.0987  +  (2  X  0.1136) 

1.3259 

20 

1.0987  +  (10  X  0.1136) 

2.2347 

RELATIVE  WEIGHTED  PRODUCTS  (RWPS)  22.2762 

RWPS  PER  DISPOSITION  (22.2762/20)  1.1138 


Note: 

1.  The  above  illustration  represents  examples  from  all  foiur  rules  set  forth  on  the  first 
page  of  this  appendix. 

2.  RWPS  per  patient  cannot  exceed  the  CHAMPUS  Weight  for  patients 
receiving  200%  per  diem  accumulation  of  RWPS 


**  Example  from  Mayer  (1988) 
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Incorporating  RWPS  of  DRG  198  With  Other  Facility  DRGs 


DRG 

BIOMETRICS 

DISPOSITIONS 

RWPS 

015 

10 

7.2041 

021 

21 

12.2136 

039 

47 

32.7073 

062 

74 

29.6444 

069 

215 

101.3940 

090 

124 

116.6220 

134 

81 

55.8981 

155 

40 

84.2000 

160 

124 

101.8164 

186 

94 

39.3296 

198  (Cholecystectomy) 

20 

22.2762 

254 

201 

103.9974 

294 

22 

16.6232 

356 

75 

74.9925 

373 

298 

151.9800 

391 

201 

28.2204 

430 

71 

90.4966 

445 

64 

52.3264 

467 

39 

13.6539 

468 

41 

68.7898 

TOTAL  1,862  Dispositions  1,204.3859  RWPS 


Case  Mix  Index  (CMI  or  Mean  RWPS)  =  TOTAL  RWPS/TOTAL  DISPOSITIONS  =  0.6468 

To  compare  to  other  DoD  facilities,  divide  this  MTF’s  CMI  hy  the  CMI  of  DoD 
during  1986  (0.8109)  to  obtain  the  Relative  Case  Mix  Index  (RCMI). 

RCMI  =  MTF  CMI  /  DoD  CMI  =  0.6469/0.8109  =  0.7976 


Note.  The  RCMI  is  calculated  by  determining  first  the  mean  RWPS  for  dispositions  finm 
the  MTF  and  then  dividing  by  the  DoD  CMI.  The  result  is  now  comparable  to  other  DoD 
facilities,  and  direct  comparison  of  average  patients  between  facilities  can  be  made. 
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Appendix  B  (cont’d) 

CALCULATION  OF  INPATIENT  WORK  UNITS  (IWU) 

IWU  =  Medical  Expense  and  Reporting  Summary  (MEPRS)  Dispositions  X  RCMI 


Normally  the  dispositions  fitim  an  MTF’s  MEPRS  system  will  indicate  a  larger 
number  of  dispositions  than  shown  on  the  PASBA  Biometric’s  Summary  and  will  be  used 
when  calculating  IWUs.  The  assixmption  is  made  that  those  dispositions  which  are  not 
used  in  the  RCMI  calculations  are  similar  to  those  used  (Soule,  1988). 

Thus,  if  the  MEPRS  dispositions  =  1,987  then: 

Total  IWUs  =  1,987  X  0.7976  =  1,584.8 


CALCULATION  OF  AMBULATORY  WORK  UNITS  (AWU) 

The  AWU  was  derived  firom  analysis  of  1985  MEPRS  data  and  reflects  relative  cost 
for  outpatient  visits  at  the  third  subaccount  level  (Mayer,  1988).  For  example: 

ORTHOPEDIC  CLINIC  SUBACCOUNTS 


2PRS  CODE 

SUBACCOUNT  WORK  CENTER 

AWU  WEIGHT 

BEA 

Orthopedic 

0.0362 

BEB 

Cast 

0.0200 

BEC 

Hand  Surgery 

0.0232 

BED 

Neuromuscxiloskeletal  Screening 

0.0133 

BEE 

Orthopedic  Appliance 

0.0326 

BEF 

Podiatry 

0.0211 

Total  AWUs  for  the  Orthopedic  Clinic  Subaccount  is  derived  by  multiplying  the  total 
clinic  visits  for  each  MEPRS  code  by  the  AWU  Weight  and  then  summing  the  products. 
One  AWU  reflects  the  same  relative  resource  consiunption  as  one  IWU  (Mayer,  1988). 
Thus  AWUs  and  IWUs  are  able  to  be  added  together  without  conversion  to  produce  the 
MWU. 


Medical  Work  Unit  (MWU) 

Inpatient  Work  Unit  (IWU)  +  Ambulatory  Work  Unit  (AWU) 
MWU  =  IWU  +  AWU 
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Appendix  C 


IPDS  Age  Codes 


CODES  DEFINITION 

T1  Newborn,  Preterm  (37  weeks  or  less  gestation) 

T2  Newborn,  Term  (38  through  41  weeks  gestation) 

T3  Newborn,  Post-term  (42  weeks  or  more  gestation) 

DO  0  DYS . Less  than  one  day 

D1  1  DY. . One  day,  less  than  two 

D2  2  DYS . Two  days,  less  than  three 

D3  3  DYS . Three  days,  less  than  four 

D4  4  DYS . Four  days,  less  than  five 

D5  5  DYS . ..Five  days,  less  than  six 

D6  6  DYS . Six  days,  less  than  one  week 

W1  7  DYS-13  DYS....One  week,  less  than  two 

W2  14  DYS-20  DYS. ..Two  weeks,  less  than  three 

W3  21  DYS-27  DYS.. .Three  weeks,  less  than  four 

W4  28  DYS-31  DYS.. .Four  weeks  to  one  month 


Ml  1  MO . One  month,  less  than  two 

M2  2  MOS . Two  months,  less  than  three 

M3  3  MOS . Three  months,  less  tham  four 

M4  4  MOS . Four  months,  less  than  five 

M5  5  MOS . Five  months,  less  than  six 

M6  6  MOS . Six  months,  less  than  seven 

M7  7  MOS . Seven  months,  less  than  eight 

M8  8  MOS . Eight  months,  less  than  nine 

M9  9  MOS . Nine  months,  less  than  ten 

YO  10  MOS-11  MOS.. .Ten  months  to  one  year 

01  12  MOS-23  MOS. ..One  year,  less  than  two 

02-98  2-98 . patient’s  age  in  years,  2  through  98  years 


99  99  and  older.. ..patient’s  age  in  years,  99  or  older 


CODES 


AlO 

NIO 

MIO 

FIO 

CIO 

PIO 

OlO 


A20 

N20 

M20 

F20 

C20 

P20 

020 


A70 

N70 

F70 

C70 


A80 

N80 

F80 


A30 

N30 

M30 

F30 

C30 

P30 

030 


A40 

N40 

M40 

F40 

C40 

P40 

040 
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IPDS  Patient  Category  Codes 


TITLE 

Active  Duty  US  Uniformed  Services: 

Army 

Navy 

Marine  Corps 
Air  Force 
Coast  Guard 

US  Public  Health  Service 

National  Oceanic  and  Atmospheric  Administration 

Reserve/National  Guard  Personnel: 

Army 

Navy 

Marine  Corps 
Air  Force 
Coast  Guard 

US  Public  Health  Service 

National  Oceanic  and  Atmospheric  Administration 

Cadets  of  the  Uniformed  Services  Academies: 

USMA,  West  Point,  NY 
USNA,  AnnapoUs,  MD 
USAFA,  Colorado  Springs,  CO 
USCGA,  Cadet,  New  London,  CT 

ROTC  Cadets: 

Army  ROTC  Cadet 
Navy  ROTC  Cadet 
USAF  ROTC  Cadet 

US  Uniformed  Services  Personnel  Permanently  Retired 
(Length  of  Service  or  PDRL): 

Army 

Navy 

Marine  Corps 
Air  Force 
Coast  Guard 

US  Public  Health  Service 

National  Oceanic  and  Atmospheric  Administration 

US  Uniformed  Services  Personnel  on  TDRL: 

Army 

Navy 

Marine  Corps 
Air  Force 
Coast  Guard 

US  Public  Health  Service 

National  Oceanic  and  Atmospheric  Administration 
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CODES 


A50 

N50 

M50 

F50 

C50 

P50 

050 


A60 

N60 

M60 

F60 

C60 

P60 

060 


A90 

N90 

F90 


HIO 

H20 

H30 

H40 

H50 

JIO 

J20 

J30 

KIO 

K20 

K30 

K40 

K50 

K60 

K70 


Appendix  D  (cont’d) 


TITLE 

Dependents  of  Active  Duty  Uniformed  Services 
Personnel: 

Army 

Navy 

Marine  Corps 
Air  Force 
Coast  Guard 

US  Public  Health  Service 

National  Oceanic  and  Atmospheric  Administration 

Dependents  of  Retired/Deceased  US  Uniformed 
Services  Personnel: 

Army 

Navy 

Marine  Corps 
Air  Force 
Coast  Guard 

US  Public  Health  Service 

National  Oceanic  and  Atmospheric  Administration 

Designees  of  the  Secretaries  of  the  Uniformed  Services; 

Army 
Navy 
Air  Force 

US  Civilians  Other  Than  Dependents  of  US  Uniformed 
Services  Personnel: 

Employees  of  Department  of  State  and  Associated  Agencies 
Employees  of  Other  Federal  Departments 
Employees  of  Other  Federal  Agencies 
Nonmilitary  Federal  Beneficiaries  With  Special  Status 
US  Government  Employee,  NEC 

Dependents  of  Authorized  Employees/Ofiicers  of  US  Federal 
Dependents  and  Preadoptive  Children  of  DOD  Employees  at 
Remote  Locations 

Dependents,  employees  of  Federal  Agency,  NEC 
VA  Beneficiary 
OWCP  Beneficiary 

US  Soldier’s/Airmen’s  Home  Beneficiary 
Beneficiary  of  Other  Federal  Agencies 

Seamen  (Excl  MSC/MSTS  Vessels)  and  Employees  of 
Contractors  in  Service  to  US  Government 
Beneficiaries  of  Private  Relief  Acts  of  the  US  Congress 
Beneficiaries  of  Peace  Corps/VISTA/Job  Corps 


CODES 


SIO 

S20 

S30 

S40 

S50 

S60 


QIO 

RIO 


XIO 

X20 

X30 

X40 

X50 

X52 

X60 

X70 
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Appendix  D  (cont’d) 


TITLE 

Foreign  Nationals: 

IMET/Foreign  Military  Sales  Trainee  Personnel 
Foreign  Military  Personnel 
Foreign  National  Civilian  Personnel 
Dependents  of  Foreign  Military  Personnel 
Dependents  of  Foreign  Civilian  Personnel 
Other  Foreign  Nationals 

Prisoners: 

Prisoners  of  War/Intemees 
Other  Prisoners 

Other  Patient  Categories,  NEC 
Applicants/Registrants 
Designees,  Secretaiy  of  Defense 
Civilian  Claimants 
Other  Authorized  Patient  Categories 
USO/Red  Cross  Dependent,  NEC 
Former  Spouse  of  AD/Retired  (effective  1  Jun  83) 
Former  Service  Member  -  Maternity  Care  Only 
Other  Patient  Category,  NEC 
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Appendix  E 

IPDS  Source  of  Admission  Codes 

CODES  TITLE 

0  Direct-Absent  Sick 

1  Direct 

5  Transfer  from  USN-USAF  dispensary 

6  Transfer  from  US  Army  hospital 

7  Transfer  from  US  Navy  hospital  or  hospital  ship 

8  Transfer  from  US  Air  Force  hospital 

9  Transfer  from  foreign  military  medical  treatment  facility 

L  Live-bom  infants  (newborn),  delivered  this  MTF 
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Appendix  F 

IPDS  Disposition  Status  Codes 


CODES  TITLES 

US  Uniform  Service  AD  or  ADT  Patients  Only: 

A  To  Duty 

B  To  Duty  from  TDRL 

C  To  PDRL  from  TDRL 

D  AWOL  (Dropped  from  Rolls) 


Separation/Retirement  under  the  provision  of  AR  635-40; 

E  PDRL 

F  TDRL 

G  Separation  with  Severance  Pay 

H  Separation  without  Severance  Pay 

I  Nondisability  Separation  of  personnel  identified  in  the  Drug  an 

Alcohol  Abuse  Prevention  and  Control  Program  at  or  afte 
transfer  or  referral  to  V A  or  other  nonmUitary  MTF 


Separation  under  the  provision  of  AR  635-200: 

J  Failure  to  meet  medical  procurement  standards 

K  Unfitness  or  Unsuitability 

L  Expiration  Term  or  Service  (ETS) 

M  Separation  under  the  provision  of  Other  AR 


Patients  other  than  AD  or  ADT  US  Uniform  Service: 
O  Discharged  Home 

P  Left  Facility  Against  Medical  Advice  (AMA) 

Q  Neonatal  Death  (Under  28  Days  of  Age) 


All  Patients; 

S  Transfer  to  Army  MTF 

T  Transfer  to  Navy  MTF 

U  Transfer  to  Air  Force  MTF 

V  Maternal  Death 

W  Hospital  Death,  NEC 


M  PL 
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Appendix  H 

The  PiaEmosis  Related  Group  (DRG)  Based  Methodology 
Transition  Impact  Program 

MAIN  MODULE 


code  =  1500 
project  "drgcolor" 
include  "glob_drg.pro" 


PREDICATES 

start 

mam_menu 

process_main_menu(integer) 

data_status 

rcmas_file 

load_databasesl 

load  databases2 

change_hospitals(SELECTION) 

error 


CLAUSES 

start:-  %  Call  from  goal 

makewmdow(9,31,0,"",l,0,9,80), 

makewindow(30,31,0,"",10,0,9,6), 

makewindow(31,31,0,"",10,6,9,4), 

makewindow(32,31,0,"",10,12,9,8). 

makewindow(33,31,0,'"',10,20,9,60), 

makewindow(16,31,0,"",2,28,6,16), 

makewindow(20,31,0,"",2,45,6,13), 

makewindow(17,31,0,"",2,62,6,13), 

makewindow(  1 ,31 ,145, "",0,0, 24, 80), 

load_databasesl,  load_databases2, 

cursorform(0,8),  data_status, 
main_menu, 

/*******  exit  from  program  *********/ 


shiftwindowd),  clearwindow, 

makewindow(3, 110,110,"", 10,23, 7, 35),  shiftwindow(3),nl, 
writeC  Thank  You  For  Using"),nl,nl, 
writeC'The  DRG  Impact  Prediction  Program"),pause, 
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Appendix  H  (cont’d) 


/*****♦**************#********************************************************** 
Loads  all  databases  up  front 

*****♦****♦**♦*#******************************♦****♦******♦********************/ 
load_databasesl:-  makewindow(2, 31,0, "",0,0^5, 80), 
file_str("main0.txt",Text0),write(Text0), 
makewindow(5,110,110,"",21,25,3,29), 
writeC  LOADING  PROGRAM"), 
rcmas_file,  shiftwindow(5),clearwindow,attribute(lll), 
writeC  PRESS  ANY  KEY  TO  CONTINUE"),readchai<J,attribute(110), 
removewindow(5 , 1 ), 
shiftwindow(  1  ),clearwindow, 

file_str("mainl.txt",Textl),write(Textl),patience, 
cursor(20,3),write("Loading  Databases”), 
cursor(20,69 ),  write(  "||V' ), 

consult("mdcl.dbl",macl),cursor(20, 21),  writeC  "), 
consult("mdc2.dbl",mdc2),cursor(20,23),  writeC  "), 
consultCmdc3.dbl",mdc3),cursor(20,25),  writeC  "), 
consult("mdc4.dbl",mdc4),cursor(20,27),  writeC  "), 
consult("mdc5.dbl",mdc5),cursor(20, 29),  writeC  "), 
consultC'mdc6.dbl",mdc6),cursor(20,31),  writeC  "), 
consult("mdc7.dbl",mdc7),cursor<20,33),write("  "), 
consult("mdc8.dbl",mdc8),cursor(20,35),  writeC  "), 
consult(''mdc9.dbl'',mdc9),cursor(20,37),WTiteCffl’'). 
consultCmdcl0.dbl",mdcl0),cursor(20,39),writeCH’’), 
consult("mdcll.dbl",mdcll),airsor(20,41),write(’W'), 
consult("mdcl2.dbl",mdcl2),cursor(20,43),write(’^'),!. 

loSld 

consul  tCmdcl3.dbl",mdcl3),cursor(20,45),write(''W’), 
consult("mdcl4.dbl",mdcl4),cxirsor(20,47),write{'®’), 
consul  t("mdcl5.dbl",mdcl5),CTirsor<20,49),write{'ffl'’), 
consul  t("mdcl6.dbl",mdcl6),cursor(20, 51),  writeCW’’), 
consult("mdcl7.dbl",mdcl7),cursor(20,53),write(’Jt'), 
consult("mdcl8.dbl",mdcl8),cursor(20,55),  write! 'W'), 
consul  t("mdcl9.dbl",mdcl9),cursor<20, 57),  writeC’B'), 
cons\ilt("mdc20.dbl",mdc20),cursor(20, 59), writeC®"), 
consult!  "mdc2 1 .  db  1 "  ,mdc2 1  ),cursor!20,6 1),  write!  "H ' ), 
consult!  "mdc22 .  db  1 "  ,mdc22  ),cursor!20, 63),  write!  jH’’ ), 
consult!"mdc23.dbl”,mdc23),c\irsor!20,65),write!'®’), 
consxilt!  "mdc24 .  db  1  ",mdc24  ),cxu'sor!20,67),  write!  "|p, 
consult!”mdclist.  db  1  ”  ,mdclist), cursor! 20,68 ),  writeCB" 
removewindow!22,0),pause,!. 

^ic****************************************************************************** 

Searches  for  the  ROMAS  processed  file.  If  it  exists  it  is 
imported.  If  it  does  not  exist  the  predicate  succeeds.  If 
an  error  is  found  in  the  consultation  process  the  "error" 
predicate  is  called  from  a  trap. 

A  longmenu  should  eventually  be  used  to  assist  in  locating 
the  ROMAS  file. 

♦♦♦♦♦♦♦♦♦♦**************4>******************************************************/ 

rcmas_file:-not!existfile!"rcmas.out")),!, 

rcmas_file:-trap!consuIt!"rcmas.out",top_drgs),_,error),!. 
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Appendix  H  (cont’d) 

rcmas_file;-existfile("c:\\rcmas\\rcmas.out"), 

trap(consult("c:\\rcmas\\rcmas.out",top_drgs),_, error),!. 
rcmas_file:-!. 

error:-makeMnndow(2,110,238,"  ERROR  ",18,26,5,30), 

file_str("error.txt",TEXT),write(TEXT),  pause,  removewindow(2,l),!. 


J**if*if*:tt***:ifif*^t:^^f*^l^i^lifif^t^Ht^f^t:t‘*********>l‘***************************************** 

data_status  breaks  up  what  would  be  too  large  a  predicate. 
data_status:-  current,data_l_status,  data_2_status,!. 


y  :tc «  4e  :<c :|c:|c  ***  4i  :|l  4!  4c  *  Ik  %  :|c  4c  ***:)<  4c « It:  3|ci|i  :ti  :|t  **  4:  i|c  4c!tc  4c  *****  ilt  *******  4c  %  **************  :|c  ic  :|c  4:  ^|c  itc  4:  * 

If  a  hospital  has  been  selected  during  another  session  it 
is  saved  in  the  "current.dbl"  database  file.  At  the  start 
of  each  session  the  user  is  given  the  option  of  changing  this 
hospital.  If  no  prior  hospital  has  been  selected,  the  ciorrent 
allows  predicate  displays  a  longmenu  :f  all  37  HSC  fadhties 
to  chose  from.  The  chosen  hospital  then  becomes  the  "current" 
hospital  for  future  sessions. 

*******************************************************************************y 


current;-existfile("c\irrent.dbl"),consult("cxirrent.dbl",current_hospital), 
current_hospital(_,NAME J, 
shiftwindow(  l),clearwindow,file_str<"main2.txt"  ,Text), 
write(Text),str_len(Name,Space),  Spacel=(80-Space)/2-l, 

Space2  =  round(Spacel),cursor(il,Space2),attribute{30),write(Name), 

attribute(31), 

longmenu(16,21,2,lll,110, 

["  YES,  Keep  The  Current  Hospital", 

"  NO,  Provide  A  List  of  Alternatives  "],"",1, CHOICE), 
change_hospitals(CHOICE),!. 


current;-consult("mtfdbl",all_hospitals), 

findalKN  ame  ,mtf(_,N  ame  ,_,_,_,_),L), 
repeat,shiftwindow(l),  clearwindow, 
makewindow(22,113,0,"",23,0,l,80), 

writeC  There  Are  37  Facilities  to  Choose  From,  Use  PgUp,PgDown,  Home,  End  or"), 
longmenu(3,16,15,lll,110,L,"Select  A  Hospital",l,Choice), 
mtftChoice,NAME,CATEGORY,RATE,DISP,RWPS),removewindow(22, 1 ), 
openwrite(this_hospital,"current.dbl"),writedevice(this_hospital), 
write("current_hospital(",Choice,  NAME,’"’,  ’,’  , 

’"’,  CATEGORY,  ,  RATE,  ,  DISP,  ,RWPS,  ’)’), 
clo8efile(this_hospital),  consult("current.dbl",current_hospital), 
shiftwindow(l),clearwindow,retractall(mtf(_,_,_,_,_,_)),!. 
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f***^^**********^!**************************************************************** 

longmenu  predicate  calls  from  "current" 
change_hospitals(  1 ). 


cliange_hospitals(2):-deletefile("current.dbl"), 
retractalKcurrent  hospitaK  .  ,  ,  ,  ,  ))> 
trap{deletefile(  "rcmas  .out"  ),_,true), 
retractalKtop  drgs(  .  t  t  •  •  )), current.!. 


Writes  into  a  window  the  DRG  Allocation  Rate,  MEPRS  Dispositions, 
Total  RWPS  and  the  MCCU  Allocation  Rate  for  the  current  hospital. 

data_l_status:- 

shiftwindow(l),  clearwindow,  cursor(0,14), 

writeC'All  Calculations  Are  Based  on  FY  1988  Data  For:"), 

current_hospital(_,NAME,_,RATE,DISP,RWPS), 

retract(money(_)),pay_for_mccu(MCCU_MONEY), 

retract(originalMoneyL)),assert(originalMoney(RATE)), 

str_len(Name,Space),  Spacel=(80-Spacey2-2, 

Space2  =  round(Spacel),cursor(l,Space2),attrihute(30), 
write(Name),  attribute(31), 
assert(mone^RATE)),retract(oldC._,_, 
assert(old(DISP,RWPS,0,0,0,0)), 
makewindow(2,110,110,"",4,2,ll,37). 


makewindow(3,110,0,"",6,4,l,33), 
writef("DRG  Allocation  Rate  =  $%0.2",RATE), 


makewindow(4,110,0,"", 8,4,1,33), 
writeC'MEPRS  Dispositions  =  ",DISP), 

makewindow(5, 110,0,"", 10,4, 1,33), 
writefl'Total  RWPS  =  %0.2",RWPS), 


makewindow(7,110,0,"",12,4,l,33), 

writefC’MCCU  Allocation  Rate  =  $%0.2",MCCU_MONEY), 


makewindow(6,110,110,"",4,41,ll,37),!. 


/******♦*♦♦♦***♦♦♦**##*♦******#*****♦****♦**♦♦♦*♦*♦**♦********♦**************♦** 


Writes  into  a  window  the  CMI,  RCMI,  IWU  and  IP  Reimbursement 
for  the  ciirrent  hospital.  Longmenu  selection  allows  the  user 
to  change  the  information  in  data_l_status  predicate  call. 


data_2_status:-  repeat,  calculate(CMI,RCMI,rWU,MONEY), 
shiftwindow(6),clearwindow,  nl, 
writefl"  CMI  =  %0.4",CMI),nl,  nl, 
writeK"  RCMI  =  %0.4",RCMI),nl,  nl, 
writefl"  IWU  =  %0.2",IWU),nl,  nl, 
writefi"  IP  Reimbursement  =  $%0.2",MONEY), 
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longmenu(16,24,6,lll,110, 

["  ACCEPT", 

"  Change  DRG  Allocation  Rate", 

"  Change  MEPRS  Dispositions  ", 

"  Change  Total  RWPS", 

Change  MCCU  Allocation  Rate", 

"  Definition  of  Terms"],"",l,CHOICE),  data(CHOICE),  CHOICE=l, 

shiftwindow(l),clearwindow,removewindow(7,l), 
removewindow(6,l),  removewindow(5,l),  removewindow(4,l), 
removewindow(3,l),  removewindow(2,l),!. 


data_2_status  longmenu  choices, 
datad):-  !. 


data(2):-  %%  CHANGE  DRG  ALLOCATION  RATE 
shiftwindow(3),clearwindow, 

writeC’DRG  Allocation  Rate  =  "),readreal(RATE2), 
retract(money(_)),  assert(money(IlATE2)), 
current_hospital(Choice,NAME,CATEGORY,_,DISP,RWPS), 
retract(current_hospital(_,_,_,_,_,_)), 

assert(current_hospital(ChoiceJ^AME,CATE  GORY, RATE2,DISP, RWPS)), 
nl,'vmtefi'DRG  Allocation  Rate  =  $%0.2",RATE2),!. 

data(3):-  %%  CHANGE  MEPRS  DISPOSITIONS 
shiftwindow(  4),clearwindow, 
write("MEPRS  Dispositions  =  "),  readreal(DISP2), 
old(_,RWPS,CMI,RCMI,IWU,MONEY), 
retract(old(_,_,_,_,_,_)), 

assert(old(DISP2,RWPS,CMI,RCMI,IWU,MONEY)), 

r6tr2ict(l3st( 

assert(last(DisP0WPS,CMI,RCMI,IWU,MONEY)), 
current_hospital(  CHOICE , NAME  ,CATEGORY,RATE ,_,_), 

assert(current_hosp^tal(CHOiCE,NAME,CATEGORY,RATE,DISP2,RWPS)), 
nl,write( "MEPRS  Dispositions  =  ",DISP2),!. 

data(4):-  %%  CHANGE  TOTAL  RWPS 
shiftwindow(5),clearwindow, 
writeC’Total  RWPS  =  "),  readreal(RWPS2), 
old(DISP,_,CMI,RCMI,IWU,MONEY), 
retract(old(_,_,_,_,_,J), 

assert(old(DISP3WPS2,CMI,RCMI,IWU,MONEY)), 

assert(last(DisP3^S2,CMI,RCMI,IWU,M0NEY)), 
current_hospital(Choice  ,NAME  ,C  ATEGORY,RATE ,_,_), 
retractCcurrent  hospitaK  ,  ,  .  ,  ,  )). 

assert(current_hospital(Choice,NAME,CATEGORY,RATE,DISP,RWPS2)), 
nl,write("Total  RWPS  =  ",RWPS2),!. 
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data(5):-  %%  CHANGE  MCCU  ALLOCATION  RATE 
shift  window(  7),clearwindow, 

writeC’MCCU  Allocation  Rate  =  "),readreal(MCCU_MONEY), 
retract(pay_for_mccu(_)),assert(pay_for_mccu(MCCU_MONEY)), 
nl,writefi:"MCCU  Allocation  Rate  =  $%0.2",MCCU_MONEY),!. 

data(6):-derine,!.  %%  CALLS  DEFINITIONS  MODULE 


Performs  all  the  calculations  and  database  corrections 


for  data_2_status.  Declutters  the  predicate. 


calculate{CMI,RCMI,IWU, MONEY):-  old(DISP,RWPS,_,_,_,_),money(RATE), 
CMI=RWPS/DISP,  RCMI=CMP0.8109,  IWU=DISP*RCMI, 
MONEY=RATE*IWU, 
retract(oldC, 

assert(old(DISP,RWPS,CMI,RCMI,IWU,MONEY)), 
assert(last(DisP3^S,CMI,RCMI,IWU, MONEY)),!. 


MAIN  MENU 


main_menu:-  repeat, clearwindow, 
longmenu(  7,23 ,6, 1 1 1 , 1 1 0, 

[  "  Change  Case  Mix  Of  Facility  ", 

Examine  Data  Status", 

Change  Current  Hospital  ", 

"  Import  RCMAS  Data", 

DOS  Shell 

QUIT"],"Main  Menu",  1,  CHOICE), 
shiftwindow(  1  ),clearwindow, 
trap(process_main_menu(CHOICE),_,true), 
shiftwindow(  l),clearwindow,CHOICE=6,!. 


y*****************l(l**=(c*******J|c**********************:(t********j([****:(c*****!(c*!|c***** 

Main  Menu  longmenu  calls 

:4c  3(c  3(c  ic  :4c  :4c  :|e  :te  3|t  3|e  4c  4c  :|e  3(E  ^  3|c  jfe  ](c  ;|c  3|c  :|e  ife  ]f(  4c  *  *  4e  3tc  ^  3|e  4e  :4c  #  i|c  ]|c  3|c  :(c  3|c  4c  4c  *  #  *  *  *  *  *  *  *  ic  3tc  :1c  :fc  3(c  3|c  3k  *  *  ^ 

process_main_menu(l)  %%  CHANGE  CASE  MIX  OF  FACILITY 
changeCaseMix,!. 


process_main_menu(2)  %%  EXAMINE  DATA  STATUS  FOR  CURRENT  HOSPITAL 
data_l_status,  data_2_status, 
shiftwindow(  1  ),clearwindow,! . 


process_main_menu(3)  %%  CHANGE  THE  CURRENT  HOSPITAL 

%%  Eliminate  th'>  RCMAS  output  file  so  as  not 
%%  to  make  a  RCMAS  comparison  with  the  wrong 
%%  faciUty 

existfile("rcmas.out"),delete^e("rcmas.out"). 
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deIetefiIe("current.dbl").retract(top_drps( 

retracKcurrent  hospitaK . )). 

current,  data_l_status,  data_2_status, 
shiftwindow(  1  ),clearwindow,! . 

process_main_menu(3);-  %%  CHANGE  THE  CURRENT  HOSPITAL 

deletefileC'cvurent.dbl"), 
retract(current_hospital(_, 
current,  data_l_status,  data_2_status, 
shiftwindow(  l),clearwindow,!. 

process_main_menu(4)  %%  GO  TO  THE  RCMAS  IMPORTING  MODULE 

rcmas_top,!. 

process_main_menu(5):-  %%  DOS  SHELL  SELECTION 

systemC'"),!. 

process_main_menu(6).  %%  QUIT  PROGRAM 


Allows  a  delay  in  execution  of  program  at  any  point 
predicate  is  called  with  a  number.  The  delay  is  only 
through  recursion  processing. 

delay(O):-!. 

delay{N):-Nl=N-l,delay(Nl). 


/****♦♦★♦*♦***♦***************************♦**********************************♦** 
Allows  a  stop  point  for  backtracking 


repeat. 

repeat  repeat. 


"Longmenu  Statusline” 

£irrowkey_statusUne:-  makewindow(21,113,0,"",24,0,l,80), 

writeC  Make  Selection  With  Arrow  Keys,  Then  Press  <RETURN>  or  FlO  To  Continue"), 

4citc  4c  :<t  :tc  #  :4citc :|c  :([!):  :|c  :ti  !(c  :|c  :|c  :tc  :tc  :|c  41  «:ti  :(i  ic  4:  *  3K  *  ^  3)1 3)1#  4l  *****%*  ^  ** ’ll  3)1  *******=!<  **!(<**:(<**** ^ 

"Please  Be  Patient  Statusline" 
window  22  must  be  removed  afterwards 

4c  4c  4c  4c  4c  4c  4c  4c  41 4c  4c  4c  3)c  4c  4c  4c  4c  3#  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  3f  4c  4c  4i  4: 4c  3#  4c  4c  4c  3#  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4: 4c  4c  4c  #  4c  4c  4<  4c  4c  4c  4c  4c  4i  4c  4<  4c  4c  4c^ 

patience:-  makewindow(WINDOW,_,_,_,_,_,_,^,makewindow(22,113,0,’"’,24,0,l,80), 
writeC  Please  Be  Patient  While  Processing  Occurs"), 

shiftwindow(  WINDOW), ! . 

y  4c  4c  4c  34  4c  4c  4c  4c  3#  41 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  1#  4c  4c  4c  41 4c  #  4c  4c  4c  4c  4c  4c  #  4c  4c  3#  4c  4c  3#  4c  4c  4c  4c  4c  4c  4c  4c  #  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 

"PAUSE  Statusline" 

4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  3»  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  3)c  4c  3)c  4c  3)c  3)c  4c  4c  4c  4c  4c  4c  4c  4c  4c  3)c  4c  4c  4cy 


pause:-  makewindow(23,113,0,"",24,0,l,80), 

writeC’  Press  Any  Key  To  Continue"), 

readchar(_),removewindow(23,l),!. 
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Initial  Database  Assertions 

**:m**^l*0***^f*****^l**Mf******************m************************************/ 


old(0, 0,0, 0,0,0). 

last(0,0,0,0,0,0). 

new(0,0,0,0,0,0). 

change(0,0,0,0,0,0). 

money(0). 

originalMoney(0). 

total_disp(0). 

pay_for_mccu(22.23). 

top_drgs(0,0,"",0,0,0). 

scenarioDb(0,0,0,0). 

sceuarioWindowDb(0,0). 

Goal  start. 
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Appendix  H  (cont’d) 
POPUP  MENU  MODULE 


^***4t*3ti**********lt!*!tl****^iltS*)ll***********^!m*************************************** 

This  Popup  menu  is  adapted  firom  TURBO  PROLOG’S  Toolbox. 

The  code  in  raw  form  is  cop)Tighted  and  may  not  be  used 
without  ownership  of  the  original  software  or  permission 
from  BORLAND  International  Inc.,  Scotts  Valley,  CA  95066. 

It  is  provided  for  educational  purposes  only.  The  executable 
program  using  this  code  is  not  copyright  protected  and 
may  be  copied  without  violating  cop3night  law. 


project  "drgcolor" 
include  "glob_drg.pro" 


PREDICATES 


longmenuinit(ROW,COL,integer,integer, integer, STRINGLIST, STRING, ROW, COL,ROW,COL,ROW) 
longmenul(SYMBOL,ROW,COL,ROW,COL,WATTR,STRINGLIST,ROW,ROW,ROW,ROW,ROW, 
ROW) 

longmenu2(SYMBOL,ROW,ROW30W,ROW,ROW,ROW,KEY) 

longmenu3(ROW,ROW,ROW,ROW,ROW,ROW) 

wr_part_if_changed(ROW,ROW,ROW,COL,STRINGLIST) 

write_partJist(ROW,ROW,ROW,ROW,COL,STRINGLIST) 

max(ROW,ROW,ROW) 

max(COL,COL,COL) 

max(LEN,LEN,LEN) 

max(INTEGER,INTEGER,INTEGER) 

min(ROW,ROW,ROW) 

min(COL,COL,COL) 

min(LEN,LEN,LEN) 

min(INTEGER,INTEGER,INTEGER) 

adjustwindow(ROW,COL,ROW,COL,ROW,COL) 

adjframe(FATTR,ROW,COL,ROW,COL) 

reverseattr(integer,ATTR)  /*  Returns  the  reversed  attribute  */ 

readkey2(KEY,INTEGER) 

writelist(ROW,COL,STRINGLIST)  /*  used  in  the  menu  predicates  */ 

CLAUSES 

longmenu(ROW,COL,MAXH,WATTR,FATTR,STRINGLIST,HEADER,STCHOICE,CHOICE):- 

3ITOMrkcy  st.fl’t’.iislinft 

longmenihnit(ROW,COL,MAXH,WATTR,FATTR,STRINGLIST,HEADER,AROW,ACOL, 

HEIGHT,LEN,NOOFROW), 

STOFFSET=STCHOICE-l, 

longmenu3(NOOFROW,HEIGHT,0,STOFFSET,BASE,OFFSET), 

longmenul(cont,AROWACOL,HEIGHT,LEN,WATTR,STRINGLIST,NOOFROW,-l,BASE, 

OFFSET,BASEl,OFFSl), 

CHOICE  =  BASEl  +  OFFSl+1, 
removewindow.remove  window(21 ,1 ). 
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longmenuinit(ROW, COL, MAXH,WATTR,FATTR,STRINGLIST, HEADER, AROW^COL, 
HEIGHT,NOOFCOL,NOOFROW):- 
maxlen(STRINGLIST,0,MAXNOOFCOL), 
str_len(HEADER,HEADLEN), 

HEADLl=HEADLEN+4, 

max(HEADLl,MAXNOOFCOL,NOOFCOL), 

Ustlen(STRINGLIST,N),  N  >  0  ,  NOOFROW=N, 
min(NOOFROW,MAXH, HEIGHT), 
adjframe{FATTR,HEIGHT,NOOFCOL,HHl,HH2), 
adjustwindow(ROW,COL,HHl,HH2,AROWACOL), 
makewindow(81,WATTR,FATTR,HEADERAROW,ACOL,HHl,HH2). 

longmenul(cont,ROW,COL,H,WATTR,STRINGLIST,NOOFROW,OLDBASE,BASE,OFFS, 
BASE2,OFFS2)  :-!, 

wr_part_if_changed(OLDBASE,BASE,H,W,STRINGLIST), 

reverseattr(ATTR,REV), 

field_attr(OFFS,0,W,REV), 

cursor(OFFS,0), 

readkey(KEY), 

longmenu2(STOP,H,NOOFROW,BASE,OFFS,BASEl,OFFSl,KEY), 

field_attr(OFFS,0,W,ATTR), 

longmenul(STOP30W,COL,H,W,ATTR,STRINGLIST,NOOFROW,BASE,BASEl,OFFSl, 

BASE2,OFFS2). 

Iongmenul(esc,_,_,_,_,_,_,_,_,OB,OF,OB,OF):-!. 

longmenul(_,_,_,_,W,ATTR,_,_,_,OB,OF,OB,OF):- 

reverseattr(ATTR,REV), 

field_attr(OF,0,W,REV). 


Iongmenu2(esc,_,_,_,_,0,-  l,ei.^) 
longmenu2(stop,_,_,B  ,0,B,0,fkey(  10)) 
longmenu2(selection,_,_3.0,B,0,cr) 

Iongmenu2(cont,_,_,_,_,0,0,home) 

longmenii2(cont,H,LEN,_,_,Bl,01,end)  01=H-1,  B1  =  LEN-H. 

longmenu2(cont,H,LEN,B,0,Bi,01,up)  :-!,  00=0-l,longmenu3(LEN,H,B,00,Bl,Ol). 
longmenu2(cont,H,LEN,B,0,Bl,01,down)  :-!,  00=0+l,longmenu3(LEN,H,B,00,Bl,Ol). 
longmenu2(cont,H,LEN,B ,0,B1 ,01  ,pgup)  :-!,  00=0-H+  l,longmenu3(LEN,H,B ,00,B  1 ,01 ). 
longmenu2(cont,H,LEN,B,0,Bl,01,pgdn)  :-!,  00=0+H-l,longmenu3(LEN,H,B,00,Bl,01). 
longmenu2(cont,_,_,B  ,0  ,B  ,0,_). 

longmenu3(_,H,B,0,B,0)  :-O>=0,  0<H,  !. 

longmenu3(LEN,H,Bl,01,B2,02)  :-01+Bl>=LEN,!,  02=H-1,  B2=LEN-H. 
longmenu3(_,_,B  1,01 ,0,0)  :-01+B  1<0,! . 

longmenu3(_,_,Bl,Ol,B2,0)  :-Ol<0,  !,  B2=B1+01. 

longmenu3C,H,Bl,01,B2,02)  :-01>=H,  02=H-1,  B2=Bl+01-02. 

wr_part_if_changed(B,B ,_,_,_)  !. 

wr_part_if_changed(OLDB,B,H,W,CL) 

SCROLL=B-OLDB,  scroU(SCROLL,0), 
write_part_list(0,B,0,H,W,CL). 


write_part_list(_,_,H,H,_,_)  !. 

write_part_Ust(I,B,R,H,W,LIT])  I<B,!,  11=1+1, write_part_list(Il,B,R,H,W,T). 
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write_part_Ust(I,B,R,H,W,[STR  I T])  >  field_sti<R,0,W,STR),  Rl=R+l,write_part_Ust(I,B,Rl,H,W,T). 

^***1i***************************************^**if****i)i*******s)i***!ti*j 

/*  adjustwindow  takes  a  windowstart  and  a  windowsize  and  adjusts  */ 

/*  the  windowstart  so  the  window  can  be  placed  on  the  screen.  */ 

/*  adjframe  looks  at  the  frameattribute:  if  it  is  different  finm  */ 

/*  zero,  two  is  added  to  the  size  of  the  window  */ 

adjustwindow(LI,KOL,DLI,DKOL,ALI,AKOL):- 

LI<25-DLI,KOL<80-DKOL,!,ALI=LI,AKOL=KOL. 

adjustwindow(LI,_,I)LI,DKOL,ALI,AKOL):- 

LI<25-DLI,!,ALI=LI,AKOL=80-DKOL. 

adjustwindow(_,KOL,DLI,DKOL,ALI,AKOL):- 

KOL<80-DKOL,!,ALI=25-DLI,  AKOL=KOL. 
adjustwindow(_,_,DLI,DKOL,ALI,AKOL):- 
ALI=25-DLI,  AKOL=80-DKOL. 

adjframe(0,R,C,R,C);-!. 

adjframe(_,Rl,Cl,R2,C2);-R2=Rl+2,  C2=Cl+2. 


f****************************************************************/ 

/*  Readkey  */ 

/*  Returns  a  symbolic  key  from  the  KEY  domain  */ 

readkey(KEY):-readchar(T),char_int(T,VAL), readkey  1(KEY,T,VAL). 


readkey  l(KEY,_,0):-!,readchar(T),char_int(T,VAL),readkey2(KEY,VAL). 

readkey  l(cr,_, 13):-!. 

readkey  l(esc,_, 27):-!. 

readkey  l(break,_, 3):-!. 

readkey  1(  tab, 9):-!. 

readkey  l(bdel,_,8):-!. 

readkey  l(ctrlbdel ,_,  1 27) :-! . 

readkeyl(char(T),T,_)  . 


readkey2(btab,15):-!. 

readkey2(del,83):-!. 

readkey2(ins,82):-!. 

readkey2(up,72):-!. 

readkey2(down,80):-!. 

readkey2(left,75):-!. 

readkey2(  right,  77) :-! . 

readkey2(  pgup  ,73) :- ! . 

readkey2(pgdn,81):-!. 

readkey2(end,79):-!. 

readkey2(home,71):-!. 

readkey2(ctrUefl,115):-!. 

readkey2(ctrlright,116):-!. 

readkey2(ctrlend,117):-!. 

readkey2(ctrlpgdn,118):-!. 

readkey2(ctrlhome,l  19):-!. 

readkey2(ctrlpgup,132):-!. 

readkey2(ques,63):-!. 

readkey2(fkey(N),VAL):-  VAL>58,  VAL<70,  N=VAL-58,  !. 
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readkey2(fkey(N),VAL):.  VAL>=84,  VAL<104,  N=ll+VAL-84,  !. 

maxlen([HIT]JVIAX,MAXl)  str_len(H, LENGTH),  LENGTH>MAX,!, 
maxlen(T, LENGTH, MAXI). 
maxlen(LIT],MAX,MAXl)  maxlen(T,MAX,MAXl). 
maxlen([],LENGTH,LENGTH). 
listlen([],0). 

Ustlen(LIT],N):- 

Ustlen(T,X), 

N=X+1. 

writelist(_,_,[]). 
writelist(LI,ANTKOL,[H  I T]):- 

field_str<U,0,ANTKOL,H), 

LI1=LI+1, 

writelist(LIl,ANTKOL,T). 


min(X,Y,X):-X<=Y,!. 

min(_,X,X). 


max(X,Y,X):-X>=Y,!. 

max(_,X,X). 


Makes  visible  the  bar  of  the  menu 


*************ti*****^i*Htt********************************************************^ 


reverseattr(Al,A2):- 

bitand(Al,$07,Hll), 

bitlefKHll,4,H12), 

bitand(Al,$70,H21), 

bitright(H21,4,H22), 

bitand(Al,$08,H31), 

A2=H12+H22+H31. 
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DEFINITIONS  MODULE 


project  "drgcolor" 
include  •\ob_drg.pro" 

PREDICATES 

definition(integer) 


CLAUSES 

define:-  repeat, 

longmenu(16,29,6,lll,110, 

[  "  RWPS  ", 

CMI  ", 

"  RCMI", 

"  DoD  CMI", 

"  IWU", 

"  Retxim  To  Menu  "],"Define",6,CHOICE), 
definition(CHOICE),  CHOICE=6,!. 

definition(l):-makewindow(90, 111, 110,"", 16,0,8,80), 

file_str("rwps.txt",Text),write(Text),pause,removewindow(90,l),!. 

definition(2):-makewindow(90,lll,110,"",16,0,8,80), 

file_str("cmi.txt",Text),write(Text),pause,removewindow(90,l),!. 

definition(3):-makewindow(90,lll,110,"",16,0,8,80), 

file_str("rcmi.txt",Text),write(Text),pause,removewindow(90,l),!. 
definition(4):-makewindow(90, 111, 110,"", 16,0,8,80), 

file_str("dod_cmi.txt",Text),write{Te3rt),pause,removewindow(90, 1 ), !. 
definition(5):-makewindow(90,lll,110,"",16,0,8,80), 

file_str("iwu.txt",Text),write(Text),pause,removewindow(90,l),!. 

definition(6):-!. 
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CMI  MANIPULATION  MODULE 


code  =  2500 
project  "drgcolor" 
include  "glob_drg.pro" 


DOMAINS 

RWPS,  AGE,  SERVICE,  GeoMean,  MTF_ALOS,  DoD_ALOS,  DRG_PAYMENT  =  real 
OLD.DISP,  New.ALOS,  MTF_MCCU_PAYMENT_EACH,  ALOS  =  real 
DIAGNOSES,  PROCEDURES,  CHANGE_RWPS,  RCMI2,  RATE,  NewRate=  real 
ScenarioDisp,CURRENT_DISP,DRG,  ChangcJnDisp  =  integer 
ServiceName,  MdcName  =  string 


PREDICATES 

delete(string,stringlist,stringlist) 

more 

background 

update  l(ChangeInDisp,PICK,MDC,  ALOS) 
update2(ChangeInDisp,PICK,MDC) 
update3(ChangeInDisp,CHANGE_RWPS) 
totalChange 

processMore(SELECTION) 

oldPlus 

bonus(RCMI2,RATE,NewRate) 

change_alos(  SELECTION  ,^OS  J^ew_ALOS) 

rwps(GeoMean,Wr,ST,LT,integer,real,real) 

ranges(real,real,real,real,real) 

ask(SELECTION,PICK,MDC) 

write_ask(PICK,MDC,ChangeInDisp,ALOS) 

howmanyt  integer  ,real,MdcName,GeoMean,ST,LT,integer,real) 

benefit(DRG_PAYMENT,MTF_MCCU_PAYMENT_EACH,OLD_DISP) 

grammer(ChangeInDisp,STRING,COL) 

noRCMAS 

noRCMAS(SELECTION) 

delete_any_blanks(stringlist,stringlist) 

howman3rmore(SELECTION,OLD_DISP,ChangeInDisp) 

nowhowman3rmore(SELECTION,ChangeInDisp) 

heart 

scenario(DRG,OLD_DISP,MTF_ALOS,DoD_ALOS) 

changeDRGs(DRG,OLD_DISP,CURRENT_DISP,MTF_ALOS,DoD_ALOS) 

plusMinus(integer,OLD_DISP,ChangeInDisp) 

showScenarioChange(  DRG) 

removeScenarioWindow 

service(integer,SERVICE) 

age(SELECTION,AGE) 

procedures(integer,PROCEDURES) 

diagnoses(integer,DIAGNOSES) 
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again(integer) 

serviceLast(stringlist) 

window34 

extract(SELiECTION,3tringlist,ServiceName,stringlist) 

CLAUSES 

changeCaseMix:-  shiftwindow(l),clearwindow,  noRCMAS,  backgrovmd, repeat, 
shiftwi  ndow(  12 ), 
resizewindow(19,51,5,26), 
longmenu(  19 ,3 ,4, 1 1 1 , 1 1 0, 

["  Mass  Changes  In  Hospital  Workload  ”, 

Changes  to  Specific  Diagnostic  Groups  ", 

Return  To  Main  Menu  "], 

"  Make  Changes  To  Facility  CMI  Through:  ",2,PICK), 
shiftwindow(  12),  resizewmdow(  19,49,5,26), 
changeCaseMix(PICK),PICK  =  3,removewindow(12,l),!. 


Prior  to  entering  this  modvile,  a  check  is  made  for  a  processed 
RCMAS  output  file.  If  none  is  present,  the  user  is  prompted  to 
receive  information  on  importing  the  RCMAS  data. 


noRCMAS:-  not(existfile("rcmas.out")),file_str("change.txt",Textl), 
write(Textl),  repeat, 
longmenu(l7,20, 2,111, 110, 

["  Information  On  Importing  RCMAS  Data  ”, 

Continue  Without  RCMAS  Data  ”], 

"”,1,PICK), 

noRCMAS(PICK),!. 

noRCMAS:-!. 


noRCMAS(l):-  rcmas_top,existfile("rcmas.out”),!.  %  noRCMAS  longmenu  selections 
noRCMAS(2):-!. 


y  :4i  :4c  4e  %  4e  4e  :|e  4: 4;  #  #  %  it :(c  :fe  :4c  4e  :(c  :(c  :|e  4c  :f(  4c  4c  4c  %  %  4e  :1c  ^  :4t  4c  ^  ^  3|c  :{e  :<c  :(e  :4e  %  :tc  4c  :4c  4c  %  :(c  :4c  :(c  :(c  :(c 


Writes  the  background  to  the  screen  and  initial 
database  information  in  the  current  window 


background:-shiftwindow(  l),cl€'  uwindow, 
attribute(27), 

file_str("backgmd.txt”,Textl),write(Textl), 

attribute(31), 

old(DISP,RWPS,CMI,RCMI,IWU,MONEY), 
cursor(  1 ,14),write(DISP), 
cursor<2,14),writef("%0.2”,RWPS), 
cursor(3,14),writefi:''%0.4'',CMI), 
cursor(4,14),writef("%0.4",RCMI), 
cursor<5,14),writefl:"%0.2”,IWU), 
<mrsor(6,14),writef(”$%0.2”  , MONEY), 
ranges(_,_,01dRate,_,J, 
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makewindow(12,110,110,"",19,49,5,26), 
write("  Supply  Allocation  Rate"),nl, 
writeC  Per  IWU  "),nl, 

writefl"  $%0.2",Ol(iRate  ),!. 


changeCaseMix(l):-%%  Option  Only  Available  For  Fort  Ord 

current_hospital(  15, %  Fails  If  Not  Fort  Ord 
repeat, serviceList(LIST),sMftwindow(  12), 
resizewindow(19,5,5,26), 
longmenu(9,48,13,lll,110,LIST, 

"  Select  A  Change  To:  ",12,PICK),service(PICK,SERVICE), 
shiftwindow(  12  ),resize  window( 19 ,49 ,5,26), 
las  t(OLD_DISP 

howmanymore(2,OLD_DISP,ChangeInDisp), 

extract(PICK,LIST,ServiceName,_), 

window34,writef("%7.0  %30",ChangeInDisp,ServiceName),nl, 
longmenu(20,5,2,lll,110, 

["  Using  1988  Mean  of  27.24  Years  ", 

"  Using  Another  Mean  "], 

"  Select  A  Mean  Age  For  Additions  ",l,CHOICE), 
age(CHOICE,AGE), 
longmenu(20,5 ,2, 1 1 1 , 1 1 0, 

["  Using  1988  Mean  of  1.27  ", 

"  Using  Another  Mean  "], 

"  Select  A  Mean  Number  of  Procedures  ",1, SELECT), 
procedures(SELECT,PROCEDURES), 
longmenu(20,5,2,lll,110, 

["  Using  1988  Mean  of  2.109  ”, 

"  Using  Another  Mean  "], 

"  Select  A  Mean  Nximber  of  Diagnoses  ",l,GOTIT), 
diagnoses(GOTIT,DIAGNOSES), 
makewindow(60,110,110,"1988  Average",19,27,5,52), 
writeC  Do  You  Wish  To  Accept  3.635  Days  As"),nl, 
writeC  Representative  of  the  Average  Length  of  Stay?"),nl, 
grammer(ChangeInDisp,STR,COL),cursor(2,COL),write(STR), 
longmenu(19, 1,3,111, 110, 

[  "  NO:  &lect  Another  "  , 

"  NO:  SAME  DAY  SURGERY  ", 

"  YES:  Accept  As  Is  "  ],"",3,ALOS_CHOICE), 
remove  windovK  60, 1 ), 

change_alos(ALOS_CHOICE,3.635,New_ALOS), 


CHANGE  RWPS  =  Ch^^lXp*  %ttal  Change  in  RWPS 
((New_ALOS*0.086186)  + 

(AGE*0.003110)  + 

SERVICE  + 

(DIAGNOSES*0.019917)  + 

(PROCEDURES*0.028702)  - 

0.0056191  +  %  Adiustment  for  Transfered  In/Outs 

0.224681),  %  Regression  Equation  Constant 

l***-^*************************************************************************l 


Implementing  DRGs 
80 


Appendix  H  (cont’d) 


update3{ChangeInDisp,CHANGE_RWPS),  shiftwindow(12), 

resizewindow(  1 9 ,5 1 ,5 ,26), 

longmenu(19,2,3,lll,110, 

["  Clear  All  Entries  and  Make  New  Mass  Change  ", 
Reselect  Change  Option  ", 

Make  Another  Mass  Change  "], 

"",2,ANOTHER),  shiflwindow(12), 
resize  window(19,49,5,26), 
again(ANOTHER),ANOTHER  =  2,!. 


changeCaseMixd):-  %%  Notice  That  Only  Fort  Ord  Is  Allowed  This  Option 
makewindow(60,110,238,"NOTICE", 10,24,8,32), 
me_str("ord.txt",TEXT),write(TEXT), 
pause  ,removewindow,fail,!. 

changeCaseMix(2):-repeat, 

longmenu(17,5,5,lll,110, 

["  From  Those  DRGs  Seen  By  This  MTF  ", 

From  A  List  of  MDCs  ", 

By  Typing  a  Known  DRG  Number  ", 

Import  RCMAS  Data  "], 

"  Select  A  DRG  To  View  And/Or  Change  ",1, WHICH), 
ask(WHICH,PICK,MDC),  %  Returns  Pick  &  MDC  which  =  a  DRG 

write_ask(PICK,MDC,ChangeInDisp,ALOS), 

%  Returns  Disposition  Change  and  either 
%  geometric  mean  (if  never  seen) 

%  or  current  Average  Length  of  Stay  (if  seen) 

updatel(ChangeInDisp,PICK,MDC,ALOS), 

%  Allows  change  in  Average  Length  of  Stay 
%  Calculates  relative  weighted  product  change 
%  Calls  Update3  predicate  which 
%  delineates  changes  fix)m  update 

removeScenarioWindow,removewindow(2,l), 
update2(ChangeInDisp,PICK,MDC),  more,!. 

changeCaseMix(3):-!. 


^^ii^ili^^titi^^^ilcit^^t^^tiili^ti***********************************^^************************** 


Provides  a  stringlist  of  all  services 


******^t*^*^iimt*****************************************************************f 


serviceList(["  (Jeneral  Surgery  ", 
General  Medicine  ", 
"  Pediatrics  ", 
Obstetrics  ", 

"  Newborn  Nursery  ", 
"  Orthopedics  ", 
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"  Podiatry  ", 

"  Oral  Surgery", 

"  Family  Practice:  Medicine  ", 

"  Family  Practice:  Obstetrics  ", 
"  Other  Single  Service  ", 

"  Hospital  Globally  "]). 


^)^!^lifH:^:^:^tl^^l********************************************************************** 

Blinking  indication  on  window  that  DRG  has  been  changed 
during  the  scenario 

^Hl^t^lfiti**:^!***********************************************************************/ 


window34:-existwindow(34),shiftwindow(34),!. 

window34:-makewindo\^34,110,110,"  Mass  Changes  Made  ”,9,1,9,44), 
writeC'Dispositions  Service"), nl,!. 


Predicates  For  ChangeCaseMix(l) 

Service  Choice 

^l^l^l:^c^ll^l)^^:^l^I^c^l^t^l^l^l*^l*l|ll|Cl|c*^c:t!^!:tc*:|c*:^^c^c:t‘********************************************/ 


service(l,SERVICE):-  SERVICE  =  0.147481,!. 
service(2,SERVICE):-  SERVICE  =  0.071973,1. 
service(3,SERVICE):-  SERVICE  =  0.052674,1. 
service(4,SERVICE):-  SERVICE  =  -0.144304,1. 
service(5,SERVICE):.  SERVICE  =  -0.324636,1. 
service(6,SERVICE):.  SERVICE  =  0.182685,1. 
service{7,SERVICE):-  SERVICE  =  0.167405,1. 
service(8,SERVICE):-  SERVICE  =  0.08842,1. 
service(9, SERVICE):-  SERVICE  =  0.080819,1. 
service(10,SERVICE):-  SERVICE  =  -0.164539,1. 
service(ll,SERVICE):-  SERVICE  =  0,1. 
service{12,SERVICE):-  SERVICE  = 


%  BA  General  Surgery 
%  AA  General  Medicine 
%  DA  Pediatrics 
%  CB  Obstetrics 
%  DB  Newborn  Nursery 
%  FA  Orthopedics 
%  FB  Podiatry 
%  BE  Oral  Surgery 
%  EA  Family  Practice:  Medicine 
EC  Family  Practice:  Obstetrics 


Other  Single  Service 

0.0280458,!./*  All  Services  Increased  * 

*  VIA  Multiplying  Above  by 

*  service  Contribution  then 

*  Summing  Totals  */ 

^^^^f^i^l^t*^:^!^t:^t^t^l^^if*^ll|Hi^l^tif^s:^l*****^l^i*^i****:^****^:^i*it‘********************************‘* 

Predicates  For  ChangeCaseMix(l) 

Age  Choice 

age(lAGE):-  AGE  =  27.242,1. 

age{2AGE):-  makewindow(61,110,110,'T988  Mean  Was  27.242  Years  ”,20,0,3,48), 
writeC  The  New  Mean  Age  In  Years  Is  =  "),repeat, 
readreal(AGE),  removewindow,!. 

y«#****««****««lti«*:tc«l(c**«««****«*****:|i«4c*4l4i**«***:t[:|i*«***4i****#lti*4^’)l**ii4i*>t‘*«4i4c«*%4: 

Predicates  For  ChangeCaseMix(l) 

Procedures  Choice 

procedures(l,PROCEDURES):-  PROCEDURES  =  1.266,1. 
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procedures(2,PRC)CEDURES):- 

makewindow(61, 110, 110, "1988  Mean  Was  1.266  ”,20,0,3,48), 
writeC  The  New  Mean  Number  Of  Procedures  Is  =  "),repeat, 
readreal(PROCEDURES),  removewindow,!. 


^^t**:ti7lfiti^!*if**yt:*i)i**************************************************************** 

Predicates  For  ChangeCaseMix(l) 

Diagnoses  Choice 

itl^:^:7^:^!^:^^^^l^i^^^:^:*t|^:^li^:|^*^l*i)^:t‘******************if************************************/ 


diagnoses(l,DIAGNOSES):-  DIAGNOSES  =  2.109,!. 
diagnoses(2,DIAGNOSES):- 

makewindow(61,110,110,"19S8  Mean  Was  2.109  “,20,0,3,48), 
writeC  The  New  Mean  Number  Of  Diagnoses  Is  =  "),repeat, 
readreal(DIAGNOSES),  removewindow,!. 
again(3):-!.  %%  Make  Another  Mass  Change 

again(_):-removewindow(34,l),processMore(l),!.  %%  Clear  Screen  and  do  again 

%%  Or  retxim  to  main  menu 


ask(l  is  for  selecting  a  DRG  from  the  actual  DRGs  seen 
by  the  facility  as  found  in  the  processed  RCMAS  file, 

RCMAS.OUT 

]fe «  4c  :(c  *  :tc  it  #  «  %  4: 4:  :4e  :<£  ♦  *  *  *  %  4:  ic  4c  4c  4: 4c  afe  3*1 4:  i|e  :4c  :4t  4c  :<t  4e  #  4c  4e  4c  !|e  *  4:  :4c  4c  *  :4c  *  *  4c  *  «  *  * 


y  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4;  4c  4: 4c  4c  4c  4c4c  4c 

no  RCMAS  DRGs  exist 

ask(l, _,_):-  not(existfile("rcmas.out")),  /*  Ensures  That  MTF  DRG  db  */ 

/*  Database  Is  Not  Present  */ 


makewindow(l  1, 110,1 10,"",19,2,5,30), 

writeC  MTF  DRGs  Have  Not  ”),nl, 

writeC  Been  Processed"),nl, 

writeC  STRIKE  ANY  KEY  TO  CONTINUE”),pause, 

removewindow(  1 1 , 1 ),!  ,fail. 

ask(l,PICK,MDC):-fmdall(Name,top_drgs(_,_,Name,_,_,_),TOPONESl), 
delete_any_blanks(TOPONES  1  ,TOPONES), 

listlen(TOPONES,LENGTH),makewindow(10,110,110,"",16, 1,8,34), 
file  strCdrgbox.txt", Textl),write(Textl),cursor(3,24), 
writefC%-4.0",LENGTH), 
longmenu(16,37,6,lll,110,TOPONES, 

"MTF  DRGs  Dispositions",l,SELECTION), 

top_drgs(SELECTION,DRG,_,_,_,_),listem(DRG,PICK,MDC), 
remove  windowt  10,1),!. 
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ask(2  is  for  selecting  a  DRG  from  first  a  Major  Diagnostic 
Category  (MDC)  and  then  a  listing  of  DRGs  within  the  selected  MDC. 

***************:ti**************ilfl*3lf*******^iiHi*********^f*************ifil!:ti**********/ 


ask(2,PICK,MDC):-  patience, findall(Name,mdclist(_^ame),L)^emovewindow(22,l), 
makewindow(10,110,110,"",14,3,10,34), 

file_str("mdcbox.txt",Textl),write(Textl),  /*  description  MDCs  */ 
longmenu(14,38,8,lll,110,L,"Major  Diagnostic  Categories", 
l,SELECTION), 

MDC=SEIjECTION,removewindow(10,l), 

mdclist(MDC,Name),  mdc(MDC,List),  /*  returns  DRGs  for  a  MDC  */ 
concatf  "MDC "  ame  ,HE  ADER), 

longmenu(14,0,8,lll,110,List,HEADER,l,PICKl),  PICKl  =  PICK, 
remove  window(  10,1),!. 


ask(3  is  for  selecting  a  DRG  by  typing  the  number  of 
a  known  DRG. 


ask(3,PICK,MDC);-  makewindow(ll,110,110,"",19,5,5,26), 
file_str("drgnumbr.txt",Textl),write(Textl), 
makewindow(15,110,110,"",20,36,3,8),  %  Entry  Window 

repeat,readint(Choice),  Choice<474,Choice>0, 
listem(Choice,PICK,MDC),not(Choice  =  500), 
remove  window(  15,1 ),  remove  window(  11,1),!. 


y  *  *  *  4:  #  *  *  *  C  4:  *  #  4:  i|<  :)i  3<t  *  41 1)1  *  4:  *  *  4i  4=  *  *  4<  4: 4<  *  4<  4:  *  4c  4: 4c  *  4c  #  iti :«  *  * :«  *  *  :tc  #  :ti  :tc  *  %  %  :4i  4:  :4c  ^  ^  :tc  :<[  :<c  ;tc 


ask(5  enters  the  RCMAS  import  module  for  processing 
RCMAS  output. 

4: 4c  4: 4c  4c  4c  4c  4c  4c  4c  4: 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c^ 


ask(5,PICK,MDC);-rcmas_top,  PICK  =  0,MDC  =  0,!. 


^4c  4: 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4: 4c  4c  4: 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c*4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


write_ask  first  determines  the  user  has  not  requested 
information  about  Heart  Transplants  (DRG  103)  or  DRG  438 
which  is  not  used.  Thereafter  the  predicate  coordinates 
the  return  of  the  change  in  dispositions  for  the  scenario 
and  what  the  average  length  of  stay  will  be  for  the  change. 

If  there  is  no  change  in  dispositions,  then  the  "0"  for 
change  in  dispositions  causes  all  predicates  to  succeed 
without  writing  a  change  to  the  windows. 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c  4: 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  #  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c^ 


write_ask(PICK,MDC,ChangeInDisp,ALOS):- 

PICK  =  6,MDC  =  20,heart,ChangeInDisp=0,ALOS=0,!. 
write_ask(PICK,MDC,ChangeInDisp,ALOS):- 

PICK  =  1,MDC  =  5,heart,ChangeInDisp=0,ALOS=0,!. 


write_ask(PICK,MDC,ChangeInDisp,ALOS);- 
mdclistf  MDC  ,MdcN  ame ), 

which(PICK,MDC,DRG,Name,WT,(jeoMean,ST,LT), 
makewindow(2,lll,lll,Name,0, 10,19,60), 

howmany(DRG,WT,MdcName,(ieoMean,ST,LT,ChangeInDisp,ALOS),!. 
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heart:-makewindow(60, 110, 238, "ERROR", 6,20,13, 40), 

file_str("heart.txt",TEXT),write(TEXT),pause,removewindow(60,l),!. 


This  predicate  succeeds  if  the  fadhty  has  treated 
patients  with  the  called  DRG 


*:ti****************************************************************************^ 


howmany(DRG,WT,MdcName,GeoMean,ST,LT,ChangeInDisp,MTF_ALOS):- 


scenario(DRG,OLD_DISP,MTF_ALOS,DoD_ALOS),  not(OLD_DISP=0), 
cursor(0,26),write("DRG  ",DRG), 
file_str("margin.txt",TEXT),write(TEXT), 

str_len(MdcName,MDC_Length),(58-  (22  +MDC_Length))/2=MDC_COLl, 

MDC_COL  =  round(MDC_COLl), 

firontstr(2,MdcName,_,MdcNameShorter), 

cursor<  1  ,MDC_COL),attrihute(  1 10), 

writef("Weight  %0.4  MDC  %0.40",WT,MdcNameShorter), 

attributed  11), 

cursor(2,35),writef("%3.1  Days”,ST), 
cursor(3,35),writefl"%3.1  Days",LT), 
current_hospital(_,NAME 
str  len(NAME,NAME  LENGTH), 

str_int(Str_OLD_DISP,OLD_DISP),  str_ien(Str_OLD_DISP,Str_OLD_DrSP_Len), 
str_int(Str_DRG,DRG),  str_len(Str_DRG,Str  DRG_Len), 

COLl  =  (50-NAME  LENGTH)/2,  COL  =  round(COLl), 
cursor(13,COL),  writefC'In  1988  %0.56",NAME), 

31  +  Str_OLD_DISP_Len+Str_DRG_Len=TOTAL, 

Spacel=(58-TOTAL)/2,  Space2  =  round(Spacel), 
cursor(14,Space2), 

writeC’Saw  ",OLD_DISP,"  Patient(s)  Coded  With  DRG  ",DRG), 
cursor(4,35),writef("%3.1  Days",DoD_ALOS), 
cursor(5,35),writef("%3.1  Days",MTF_ALOS), 
pay_for_mccu(  MC  CU_RATE ), 


rwps(GeoMean,WT,ST,LT,OLD_DISP,MTF_ALOS,RWPS),  %  Calculates  RWPS 


money(RATE),  CMI=RWPS/OLD_DISP,  RCMI=CMI/0.8109,IWU=OLD_DISP*RCMI, 


/**  Total  **/ 

DRG_PAYMENT  =  RATE*IWU, 

/**  Each  **/ 
MarginDRGPay  =  RCMI*RATE, 


/♦♦***♦******♦*  Calculates  MCCU  Payments  *♦**♦****♦*********♦***/ 
/**♦*  mTF  ALOS  ****♦♦*/ 


/**  Total  **/ 

MTF.MCCUPayTotal  =  ((  (10*OLD_DISP)  +  OLD_DISP*MTF_ALOS  )♦  MCCU_RATE), 
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!**  Each  **/ 

MCCUPayForMTF  =  MTF_MCCUPayTotal/OLD_DISP, 

/****  DoD  ALOS  **♦*♦**/ 

/**  Total  **! 

DoD_MCCUPayTotal  =  ((  (10*OLD_DISP)  +  OLD_DISP*DoD_ALOS  )*  MCCU_RATE), 

!**  Each  **! 

DoD.MCCUPayEach  =  DoD_MCCUPayTotal/OLD_DISP, 


benefit(MarginDRGPay, MCCUPayForMTF, OLD_DISP), 
attributed  10), 

cursor(9,40),writefU$%7.2",DRG_PAYMENT), 

cursor(9,26),writef("$%6.2'’,MarginDRGPay), 

cursor(  10,40),  writefl  "$%7.2",DoD_MCCUPa)^otal), 

cursor(10,26),writefi:"$%6.2"J)oD_MCCUPayEach), 

cursor(ll,40),writefl:"$%7.2",MTF_MCCUPayTotal), 

cursort  1 1 ,26),  writefl  ”$%6.2",MCCUPayForMTF),attribute(  1 1 1 ), 

showScenarioChange(DRG), 

longmenu(19,5,3,ll  1,110, 

["  Eliminate  This  Category  Of  Care  ", 

"  Add/Subtract  Patients  ", 

Continue  Current  Level  of  Care  "], 

"",2,CHOICE), 

howmanymore(CHOICE,OLD_DISP,ChangeInDisp), 

changeDRGs(  DRG,OLD_DISP,ChangeInr>isp  ,MTF_ALOS  ,DoD_ALOS ), ! . 

This  second  predicate  succeeds  if  the  facility  has  not 
treated  patients  with  the  called  DRG 

howmany(DRG,_,MdcName,_,ST,LT,ChangeInDisp,ALOS):-listem(DRG,PICK,MDC), 
cursor(0,26),write("DRG  ",DRG), 
which(PICK,MDC,_,_,WT,ALOS,_,J, 
pay_for_mccu(MC  CU_RATE  ),money(RATE ), 
file_str("m£u:gi  n2.txt"  ,TEXT),write{TCXT), 

str_len(MdcNaune,MDC_Length),(58-  (22  +MDC_Length))/2=MDC_COLl, 
MDC_COL  =  round(MDC_COLl), 

&x)ntstr(2,MdcName,_,MdcNameShorter), 
cursord  ,MDC_COL),attribute(  1 10), 

writefC’Weight  %0.4  From  MDC  %0.40",WT,MdcNameShorter), 
cursor(3,36),writef("%4.1  Days",ST), 
cursor(4,36),writef("%4.1  Days'',LT), 
cur8or(5,36),writef("%4.1  Days",ALOS), 

MCCUPayForMTF 

=  (10  +  ALOS)*MCCU_RATE, 

MarginDRGPay 

=  (WT/0.8109)  *  RATE, 
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cursor(10,35),writef("$%6.2",MarginDRGPay), 

cursor(ll,35),writef("$%6.2"^CCUPayForMTF),attribute(lll), 

benefit(MarginDRGPay,MCCUPayForMTF,0), 

showScenarioChange(DRG), 

longmenu(20,5,2,lll,110, 

["  Add  Patients  In  This  Category  ", 

Make  No  Changes"], 

"",l,CHOICE), 

nowhowmanymore(CHOICE,ChangeInDisp), 

changeDRGs(DRG,0,ChangeInDispALOSA^LOS),!. 

Calculates  the  difference  in  reimbiu*sement  between  the 
MCCU  system  and  DRG  system  in  this  order: 

1.  If  no  patients  were  seen  with  this  DRG  and  the  marginal 
reimbursement  under  the  DRG  system  is  positive. 

2.  If  patients  were  seen  with  this  drg  and  the  marginal 
reimbursement  under  the  DRG  system  is  positive 

3.  if  no  patients  were  seen  with  this  DRG  and  the  marginal 
reimbursement  under  the  DRG  system  is  negative 

4.  If  patients  were  seen  with  this  DRG  and  the  marginal 
reimbursement  under  the  DRG  system  is  negative 

benefit(MarginDRGPay,MCCUPayForMTF,OLD_DISP):-OLD_DISP  =  0, 

MarginDRGPay  -  MCCUPayForMTF  =  MARGIN,  MARGIN  >=  0,  cursor(15,4), 
writef("For  A  Marginal  Gain  Under  the  DRG  System  of  $%0.2", MARGIN),!. 

benefit(MarginDRGPay, MCCUPayForMTF  ,OLD_DISP):- 

MarginDRGPay  -  MCCUPayForMTF  =  MARGIN,  MARGIN  >=  0, 
cursor(15,4),TotalPay  =  MARGIN  *  OLD_DISP, 

writefUFor  A  Marginal  Gain  Under  the  DRG  System  of  $%0.2", MARGIN), 
str_real(StrTotalPay,TotalPay),str_len(StrTotalPay, LENGTH), 
(58-{37+LENGTH))/2=COLl,round(COLl)=COL,cursor<16,COL), 
writefCAnd  A  Total  Gain  With  the  DRG  System  of  $%0.2",TotalPay),!. 


benefit(MarginDRGPay,MCCUPayForMTF,OLD_DISP);-OLD_DISP  =  0, 

MarginDRGPay  -  MCCUPayForMTF  =  MARGENl,  MARGINl  <  0, 
MARGIN  =  MARGINl*-!,  cursor(15,4), 

writefUFor  A  Marginal  Loss  Under  the  DRG  System  of  $%0.2",MARGIN),!. 


benefit(MarginDRGPay,MCCUPayForMTF,OLD_DISP):- 

MarginDRGPay  -  MCCUPayForMTF  =  MARGINl,  MARGINl  <  0, 
MARGIN  =MARGIN1*-1,  TotalPay  =  MARGIN  *  OLD.DISP,  cursor(15,4), 
writefUFor  A  Marginal  Loss  Under  the  DRG  System  of  $%0.2",MARGIN), 
str_real(StrTotalPay,TotalPay),str  len(StrTotalPay,LENGTH), 
(58-(37+LENGTH))/2=COLl,round(COLl)=COL,cursor(16,COL), 
writefUAnd  A  Total  Loss  With  the  DRG  System  of  $%0.2",TotalPay),!. 
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Ret\ims  the  change  in  dispositions 
to  the  howmany  predicate  \ised  when 
there  are  already  dispositions 
being  seen 


howmanymore(l,OLD_DISP,ChangeInDisp):-  ChangeInDisp  =  OLD_DISP  *  -1  ,!. 


howmanymore(2,OLD_DISP,ChangeInDisp):- 

longmenu(  19 ,5 ,3 , 1 1 1 , 1 1 0, 

["  Add  Patients  ", 

"  Subtract  Patients  ", 

"  Continue  Current  Level  of  Care  "],"",l,CHOICE), 
makewindow(15,110,110,"",20,36,3,8), 
makewindow(60,110,110,"",18,3,6,28), 
plusMinus(CHOICE,OLD_DISP, ChangeInDisp), 
remove  window(60, 1  ),remove  window(  15, 1 ), !. 


howmanymore(3,_,ChangeInDisp);-  ChangeInDisp  =  0,!. 


4!  Ik  !)<:)<:<<  4:  lit  it!****!)!*#**#*’)!  4c  :4<4*#4:*****!|<***iE:4‘**i|t* 

Predicates  For  howmanymore(2)  longmenu 

^^c^cik^iiiliili^^ilcAlldlcilc^c^^ilc^ilciklic^^^^^ilcilcilcilc^ilcilcilcilcilcilc^^ilcilcilc^^^ilcilcilolcilc^^ilcic^^ilcilcilCilc^^ilcilc^^AsIc^^ilcilcilcilc^cy 


plusMinus(0,_, ChangeInDisp);-  %%  escape  pressed 
ChangeInDisp  =  0,!. 


plusMinus(l,OLD_DISP, ChangeInDisp):-  %%  Add  Patients 
file_str<"drgPlus.txt",TEXT),write(TEXT), 
shiftwindow(  15),repeat,  readint(ChangeInDisp), 

ChangeInDisp>=OLD_DISP*-l,!.  %  Can’t  take  away  more  than  you  had!!! 


pIusMinus(2,OLD_DISP,ChangeInDisp):-  %%  Subtract  Patients 

str_int(StrOLD_DISP,OLD_DISP),str_len(StrOLD_DISP,LENGTH), 
(26-(15+LENGTH))/2=COLl,  round(COLl)=COL, 
file_str("drgMinus.txt",TEXT),write(TEXT),  cursor(l,COL), 
writef("Up  To  %0.0  Patients.", OLD_DISP), 
shiflwindow(15),repeat,  readint(Positive), 

ChangeInDisp  =  Positive  *  -1, 

ChangeInDisp  <  9999,!.  %%%%  Only  because  window  won’t  hold  more 


plusMinus(3,_,ChangeInDisp);-  %%  Continue  Ciurent  Level  of  Care 
ChangeInDisp  =  0,!. 
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f********************************************1f^::ti^iilfiif^Hlf^i:)(:IHti^S^lilf^i^i^i^iilf^i^i^iitlif^l^:iti^:^:^:^:Hl^:H: 


Predicates  for  howmany  predicate  used  when  no  patients 

have  been  seen  with  this  DRG.  Returns  the  change  in  dispo^iitions. 


nowhowmanymore(l,ChangeInDisp):-  makewindow(ll,110,110,"",19,5,5,26),  clearwindow, 
file_str("drgamnt2.txt",TEXT),write{TEXT), 
makewindow(15,110,110,"",20,36,3,8), 
repeat,  reading  ChangeInDisp),  ChangeInDisp  >=  0, 
removewmdow(  15, 1  ),removewindow(l  1,1 ),!. 


nowhowman3rmore(2,ChangeInDisp):-ChangeInDisp  =  0,!. 


updatel(ChangeInDisp,PICK,MDC,ALOS):-ChangeInDisp  <  0, 
which(PICK,MDC,_,_,WT,GeoMean,ST,LT), 
rwps(GeoMean,WT,Sl‘,LT,ChangeInI)isp,ALOS,CHANGE_RWPS), 
update3(ChangeInDisp,CHANGE_RWPS),!. 


/*************************if*:t‘*******************!t:**********************!t:**^!**iic** 

*  If  There  Is  No  Change  In  Dispositions,  No  ALOS  Determination  Needs  * 

*  To  Be  Made.  * 

updatel(ChangeInDisp,_,_,_):*ChangeInDisp=0,  update3(ChangeInDisp,0),!. 


updatel(ChangeInDisp,PICK,MDC,ALOS):-  which(PICK,MDC,_,_,WT,GeoMean,ST,LT), 
makewindow(60,110,110,"",19,27,5,52), 
str_real(StrALOS,ALOS),str_len(StrALOS,LENGTH), 

(50-(LENGTH  +  30))/2=Columnl,round(Columnl)=Column, 
cursor(0,Column), 

writef("Do  You  Wish  To  Accept  %0.1  Days  As"  ALOS), 
nl,cursor(l,3),writo("Representative  Of  The  Average  Length  of  Stay"), 
grammer(ChangeInDisp,STR,COL),cursor(2,COL),write(STR), 
delaydOO), 

longmenu(19,l,3,lll,110, 

[  "  NO:  &lect  Another  "  , 

"  NO:  SAME  DAY  SURGERY  ", 

"  YES:  Accept  As  Is  "  ],"",3,ALOS_CHOICE), 
removewindo'MSO,  1 ), 

change_alos(ALOS_CHOICE,ALOS,New_ALOS), 
rwps(GeoMean,WT,ST,LT,ChangeInDisp,New_ALOS,CHANGE_RWPS), 
up^te3(ChangeInDisp  ,C  HANGE_RWPS),! . 


^  1 4c  4c  4c  4c  4c  4c  4c  4c  *  4c  *  «  4c « itc  4c  4t  itc «  «  4c  4e  4i  4c  dc  4c  4c  Ik  lit  4c  *  4c  41 4c  4c  4c  4c  4c  4c  4c  4ci|c  4c  4c  4c  4c  4e  4c  4c  4c  4c  4c  4c  4c  4c  4c  dc  4c  4:  etc  4c  4c  4c  4c  4c  4c  4c  4c  *  4c  dc  4ci|e  4c  4c  4c  4c  4c 

*  If  There  Is  No  Change  In  Dispositions,  This  Predicate  Call  Allows  * 

*  For  The  Predicate  To  Succeed  Without  Making  Any  Entries  * 

4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4c  4>  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ikdc  4c  4c  4cy 


update2(ChangeInDisp,_,_):-ChangeInDisp  =  0,!. 
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*  If  There  Is  A  Decrease  In  Dispositions,  No  ALOS  Determination  Needs 

*  To  Be  Made  As  The  Lost  Dispositions  Will  Use  the  Old  ALOS. 


* 

* 


update2(  ChangeInDisp,PICK,MDC)  :- 

which(PICK,MDC,DRG,Name,WT,_,_,_), 
shiftwindow(31),  writef("%3.0"JDRG),nl, 
shiftwindow(32),  writef("%0.4",WT),nl, 
shiftwindow(33),  write(Name),nl, 
shiftwindow(30),  writef("%5.0",ChangeInDisp),nl,!. 


This  Section  Allows  Changes  In  Average  Length  Of  Stay 


change_alos(l,_,New_ALOS):-makewindow(61,110,110,”",20,0,3,48), 

writer  The  New  Average  Length  Of  Stay  in  days  =  "), repeat, 
readreal(New_ALOS),  removewindow,!. 
change_alos(2,_,New_ALOS):-New_ALOS=l,!. 
change_alos(3AiOS,New_ALOS):-New_ALOS  =  ALOS,!. 


^**************iti*^^i**:t‘***’t‘*********************ilf******************************** 

*  If  There  Is  No  Change  In  Dispositions,  This  Predicate  Call  Allows  * 

*  For  The  Predicate  To  Succeed  Without  Making  Any  Entries  * 

********************************************^f*^i^!>L**^ii):****i>liti****^fi^*i^**ilf!tiifi*******^ 

update3(ChangeInDisp,_):-  ChangeInDisp  =  0,!. 


update3(ChangeInDisp,J:-  lasUDISP.  DISP+ChangeInDisp=0, 

makewindow(60,110,238,"WARNING",6,20,13,40), 
file_str(  "NoCensus.  tsd"  ,TOXT),  write{TEXT),pause  ,removewindow(  60,1),!. 

update3(ChangeInDisp,CUANGE_RWPS):-  last(DISP,RWPS,_,_,_,J,  money(RATE), 

DISP2=DISP+ChangeInDisp,  RWPS2=RWPS+(CHANGE_RWPS),  CMI2=RWPS2DISP2, 
RCMI2=CMI2/0.8109, 

bonus(RCMI2,RATE,NewRate),shiftwindow(12),clearwindow, 
writeC  Supply  Allocation  Rate"),nl, 
writer  Per  IWU  "),nl, 

writefT  $%0.2",NewRate), 

IWU2=D1SP2*RCMI2, 

MONEY2=NewRate*IWU2, 


retract(money(_)),  assert(money(NewRate)), 

3r6tr2ict(n©w( 

assert(new(DisP^RWPS2,CMI2,RCMI2,IWU2,MONEY2)), 

/*  New  Window  */ 
shiftwindowt  16),clearwindow, 
write<DISP2),nl, 
write  fr%0.2",RWPS2),nl, 
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writef("%0.4",CMI2)^, 

writef("%0.4",RCMI2),nl, 

writef("%0.2",IWU2),nl, 

writefl;"$%0.2",MONEY2),  oldPlus,  totalChange,!. 

grammer(ChangeInDisp, STRING, COL):-ChangeInDisp=l,  str_int(Num,ChangeInDisp), 
concatC'For  This  ",Num,One), 

concat(One,"  Patient?", STRING), strJen(STRING, LENGTH), 
Space=(50-LENGTH)/2,COL  =  roimd(Space),!. 

grammer(ChangeInDisp,STRING,COL):-  str_int(Num,ChangeInDisp), 
concatC'For  These  "N’iio,Many), 

concat(Many,"  Patients?",STRING),str_len(STRING, LENGTH), 
Space=(50-LENGTH)/2,COL  =  round(Space),!. 


/***  MTF  ch6  is  in  the  next  lower  peer  group,  and  the  RCMI  has 

not  changed  ***************************♦*****************************/ 


bonus(RCMI,RATEN^ewRate);-  current_hospital(_,_,PEER,_,_,_),PEER  =  "CH6", 
ranges(_,LowerRCMI,01dRate,_,_), 

RATE>01dRate,  RCMI  <  LowerRCMI,RATE  =  NewRate,!. 


/***  MTF  CH6  is  in  the  next  lower  peer  group,  and  the  RCMI  has 

changed  back  to  its  normal  level  **********************************/ 
bonus(RCMI,RATE,NewRate):-  current_hospitalC,_, PEER, _,_,_), 

PEER  =  "CH6", 

ranges(_,LowerRCMI,01dRate,_,ChangeDown), 

RATE>01dRate,  RCMI  >  LowerRCMI,NewRate  =  OldRate  +  ChangeDown, 

makewindow(50,110,110,”", 17,46,7,34), 

file_str("ch56up.txt",Text),write(Text), 

cursor(  1 , 1 3),  writefl  "%0.2 "  ,LowerRCMI), 

cursor(4,13),writefC'$%0.2",ChangeDown), 

retract(money(_)),assert(money(NewRate)), 

pause,removewindow(50,l), 

shiftwindow<16),attribute(31),!. 


/***  MTF  CH6  RCMI  has  dropped  and  the  MTF  is  in  the  next  lower 

peer  group,  however,  the  rate  increases  for  MTFs  in  peer  group  CH6  ***/ 

bonus(RCMI,RATEN^ewRate):-  current_hospital(_,_,PEER,_,_,_), 

PEER  =  "CH6", 

ranges(_,LowerRCMI,01dRate,_,ChangeDown), 

RCMI<LowerRCMI,RATE=01dRate, 

NewRate=01dRate  •  ChangeDown, 
makewindow(50, 1 10, 1 10,"", 17,46,7,34), 
file_str(  "ch56down.  txt"  ,Text),  write(Text), 
cursord  ,13),writefC'%0.2",LowerRCMI), 
cursor(4,13),writefC'$%0.2",ChangeDown), 
retract(money(_)), 
assert(monej<NewRate)), 
pause,removewindow(50,l), 
shiftwindow(  16),attribute(30),!. 
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/***  RCMI  has  increased  and  the  the  MTF  is  in  the  next  higher  peer  group, 
however,  the  rate  decreases  for  MTFs  in  peer  group  CH5  ***/ 

bonus(RCMI,RATE  J^ewRate):-  current_hospitalC,_,PEER,_,_,_), 

PEER  =  "CH5", 

ranges(UpperRCMI,_,01dRate,ChangeUp,_), 

RCMI<UpperRCMI  ,RATE =01dRate, 

NewRate=01dRate  +  ChangeUp, 

makewindow(50,110,110,'’",17,46,7,34), 

file_str("ch56up.txt",Text),write(Text), 

cursor(l,13),writef("%0.2",UpperRCMI), 

CTn:«or(4,13),writef("$%0.2",ChangeUp), 

retract(money(_)), 

assert(money(NewRate)), 

pause,removewindow(50,l), 

shiftwindow(  16),attribute(3 1),!. 

/****  MTF  CHS  has  increased  to  the  next  higher  peer  group,  but  there 

has  been  no  changes  j******************^ 

bonus(RCMI,RATE  J^ewRate):-  current_hospitalC,_,PEER,_,_,_), 

PEER  =  "CHS", 

ranges(_,LowerRCMI,01dRate,_,_), 

RATE<01dRate,  RCMI  >  LowerRCMI,RATE  =  NewRate,!. 

/*****  MTF  chS  is  in  the  next  higher  peer  group  and  has  now  fallen 

to  its  original  position  **********!it*******^ 

bonus(RCMI,RATE  ,NewRate):-  current_hospitalC>_,PEER,_,_,_), 

PEER  =  "CHS", 

ranges(_,LowerRCMI,01dRate,ChangeUp,_), 

RATE<01dRate,  RCMI  >  LowerRCMI,NewRate  =  OldRate  -  Changeup, 
file_str("chS6down.txt",Text),write{Text), 
retract(money<_)),assert(money(NewRate)), 
shift window(  16),attribute(3 1 ),!. 

/*****  RCMI  is  within  the  range  for  the  same  peer  group,  no  changes  **********/ 

bonus(RCMI,RATE,NewRate):-  ranges(UpperRCMI,LowerRCMI,01dRate,_,_), 

RCMI<UpperRCMI,  RCMI>LowerRCMI,RATE=01dRate,NewRate=01dRate,!. 

/****  RCMI  has  just  exceeded  the  Upper  Limit,  therefore  the  ra^^e  increases  ***/ 

bonus(RCMI,RATEJNewRate):-  ranges(UpperRCMI,_,01dRate,ChangeUp,_), 
RCMI>UpperRCMI,RATE=01dRate,NewRate=01dRate  +  ChangeUp, 
makewindow(S0,110,110,"",17,46,7,34), 
file_str("above.txt",Text),write(Text), 
cursor(  1 ,13),writef("%0.2"  ,UpperRCMI), 
cursor(4,13),writef("$%0.2",ChangeUp), 
retract(money(_)), 
ksserUmonejKNewRate)), 

pause  4‘emovewindow(S0, 1  ),shiftwindow(  16),attribute{30), !. 
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/******  RCMI  has  exceeded  the  Upper  limit,  but  there  is  no  change 

as  the  MTF  has  already  increased  to  the  next  peer  group  *******/ 

bonus(RCMI,RATE,NewRate);-  ranges(UpperRCMI,_,01dRate,ChangeUp,_), 
RCMI>UpperRCMI,RATE>01dRate,NewRate=01dRate  +  ChangeUp, 
shiftwindow(  16),attribute(30),!. 

/******  RCMI  has  dropped  but  the  MTF  cannot  lower  its  peer  group  ********/ 

bonus(RCMI,RATEJ^ewRate):-  ranges(UpperRCMI,LowerRCMI,01dRate,_,ChangeDown), 
RCMI<LowerRCMI,RCMI  <  UpperRCMI4lATE=01dRate,  ChangeDown  =  0, 
NewRate=01dRate, ! . 


/***  RCMI  has  dropped  and  the  MTF  which  had  entered  the  next  higher 
peer  group  has  now  returned  to  its  original  group  ***/ 

bonus(RCMI,RATEJ^ewRate):-  ranges(UpperRCMI,_,01dRate, ChangeUp, _), 
RCMI<UpperRCMI,RATE>01dRate, 

NewRate=01dRate, 

makewindow(50,110, 110,"", 17, 46,7,34), 

file_str("below.txt",Text),write(Text), 

cursor(l,13),writefi;"%0.2",UpperRCMI), 

(nn:«or(4,13),writef("$%0.2",ChangeUp), 

retract(money(J), 

assertCmonejKNewRate)), 

pause  ,remove  window(  50,1), 

shiftwindow(16),attribute(31),!. 

bonus(RCMI,RATFJ^ewRate):-  RCMI>0,RATE=NewRate,!. 

^:|c**********«**:'  «  <c******J(c**********************************!(i****************** 

Calculates  ’^e  increase/decrease  in  RWPS  depending  upon; 

1.  Number  of  Dispositions  (ChangeInDisp) 

2.  New  Average  Length  of  Stay  (New_ALOS) 

3.  Weight  (WT);  Short  (ST)  and  Long  Term  (LT)  Cutoff  Days 

In  order,  these  predicates  are  used  for  the  following: 

1.  Average  Length  of  Stay  is  Less  than  the  Short  term  cutoff 
and  the  average  rwps  is  less  than  the  CHAMPUS  weight. 

Calculaton  of  weight  is  based  on  the  average  length  of  stay 
times  twice  the  perdiem  weight. 

2.  As  in  1  hut  the  Calculation  is  based  on  the  weight  rather 
than  twice  perdiem  as  the  total  weight  cannot  exceed  the 
CHAMPUS  Mean. 

3.  Average  Length  of  stay  falls  within  the  ST  and  LT. 

4.  Average  Lengfth  of  Stay  exceeds  the  LT. 

rwps(GeoMean,WT,ST,_,ChangeInDisp,New_ALOS,CHANGE_RWPS):-  New_ALOS<ST, 

PER_DIEM=WT/GeoMean,  AMOUNT=PER_DIEM*2*New_ALOS,  AMOUNT<=WT, 
CHANGE_RWPS=AMOUNT*ChangeInDisp,!. 
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rwps(GeoMean,WT,ST,_,ChangeInr>ispJ^ew_ALOS,CHANGE_RWPS):-  New_ALOS<ST, 

PER_DIEM=WT/GeoMean,  AMOUNT=PER_DIEM*2*New_ALOS,  AMOUNT>WT, 
CHANGE_RWPS=WT*ChangeInDisp,!. 

rwpsC,WT,ST,LT,ChangeInDispJ^ew_ALOS,CHANGE_RWPS):-  New_ALOS>=ST,  New_ALOS<LT, 
CHANGE_RWPS=WT*ChangeInDisp,!. 


rwps(GeoMean,WT,ST,LT,ChangeInDisp^ew_ALOS,CHANGE_RWPS):-  New_ALOS>ST, 
PER_DIEM=WT/GeoMean, 

CHANGE_RWPS=((WT*ChangeInDisp>+(WT*0.6*PER_DrEM*((New_ALOS-LT)*ChangeInDisp))),!. 


oldPlus:-  shiftwmdow(20),clearwindow, 

new(DISP,RWPS,CMI,RCMI,IWU, MONEY), 
last(DISP2,RWPS2,CMI2,RCMI2,IWU2,MONEY2), 

CHG_DISP=DISP-DISP2, 

CHG_RWPS=RWPS-RWPS2,  CHG_CMI=CMI-CMI2, 
CHG_RCMI=RCMI-RCMI2,  CHG_IWU=IWU-IWU2, 
CHG_MONEY=MONEY-MONEY2, 

write(CHG_DISP),nl, 

writefi:"%0.2",CHG_RWPS),nl, 

writef("%0.4",CHG_CMI),nl, 

writefl:'’%0.4",CHG,RCMI),nl, 

writefl:"%0.2",CHG_IWU),nl, 

writef("$%0.2",CHG_MONEY), 


assert(last(DisP,R^S,CMI,RCMI,IWU, MONEY)), 

change(OLD_DISP,OLD_RWPS,OLD_CMI,OLD_RCMI,OLD_IWU,OLD_MONEY), 


TOT_CHG_DISP=CHG_DISP+OLD_DISP,  TOT_CHG_RWPS=CHG_RWPS+OLD_RWPS, 
TOT_CHG_CMI=CHG_CMI+OLD_CMI,  TOT_CHG_RCMI=CHG_RCMI+OLD_RCMI, 
TOT.CHG  IWU  =  CHG_IWU  +  OLD_IWU, 
TOT_CHG_MONEY=CHG_MONEY+OLD_MONEY, 


assert(change(f6Tl’CHG-blSP,TOT_CHG_RWPS,TOT_CHG_CMI,TOT_CHG_RCMI, 

TOT_CHG_IWU,TOT_CHG_MONEY)),!. 


Writes  entries  to  total  change  window 


totalChange;-  change(DISP,RWPS,CMI,RCMI,IWU,MONEY), 
shiftwindow<17),  clearwindow, 
write(DISP),nl, 
writef("%0.2",RWPS),nl, 
writefl:"%0.4",CMI),nl, 


Appendix  H  (confd) 
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writef("%0.4",RCMI),nl, 
writef("%0.2MWU),nl, 
writef("$%0.2", MONEY),!. 


Allows  options  after  a  single  DRG  has  been  manipulated 
*******************************************************************************^ 
more:-  longmenu(19,5,3,lll,110, 

[  "  Clear  All  Entries  "  , 

"  Reselect  Change  Option  ", 

"  Make  Another  DRG  Change  "],"",3,CHOICE), 
pn)cessMore(CHOICE),CHOICE=2, 
shiflwindow(30),  clearwindow, 
shiftwindow(31),  clearwindow, 
shiftwindow(32),  clearwindow, 
shiflwindow(33),  clearwindow,!. 


processMore(3) !. 

processMoreO:-  shiftwindow(30), clearwindow, shiftwindow(31), clearwindow, 

shiftwindow(32),clearwmdow,shiftwindow(33),clearwindow, 
shiflwindow(20),clearwindow,shiftwindow(16),clearwindow, 
shiflwindow(  17),clearwindow, 
ranges(_,_,01dRate,_,_), 
shiftwindow(  12),clearwindow, 
write("  Supply  Allocation  Rate"),nl, 
writeC  Per  IWU  "),nl, 

writefC’  $%0.2",OldRate),old(A3,C,D,E,F), 

retract(last(_,_,_,_,_,J), 
assert(last(A,B,C,D,E,F)), 
retract(change(_,_,_,_,_,J), 
assert(change(0,0,0,0,0,0)), 
retractall(scenarioDb(_,_,_,_)), 
retractalKscenarioWindowDbCi-)), 
current_hospital(_,_,_,01dRate,_,_), 
retract(money(_)),assert(money(01dRate)), 
shiftwindow(16),attribute(31),!. 


^******************************************************************************* 


Common  predicate  call  for  database  information  on  the  ciirrent  hospital 
*******************************************************************************^ 


ranges(UpperRCMI,LowerRCMI,01dRate,ChangeUp,ChangeDown):- 

current_hospital(_,_,PEER,01dRate,_,_), 

peer(PEER,ChangeUp,ChangeDown,_,_,LowerRCMI,UpperRCMI),!. 


y******************************************************************************* 


This  Section  Eliminates  £uiy  blanks  in  a  list,  blanks  ruin 
a  good  longmenu! 

*******************************************************************************^ 


CLAUSES 

delete(Element,[Element  I  Tail],Tail). 

delete(Element,[Head  I  Tail],[Head  I  List])  !,  delete{Element,Tail,List). 
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delete_any_blanks(TOPONESl,TOPONES):-delete("”,TOPONESl,TOPONES),!. 

delete_any_blanks(TOPONESl,TOPONES):-TOPONESl=TOPONES,!. 


If  The  DRG  has  been  manipulated  during  this  session,  this  predicate 
succeeds  and  the  data  used  will  be  &om  the  scenario  database. 

Will  succeed  even  if  the  DRG  was  not  originally  in  the  RCMAS  Data 
*******************************************************************************^ 


scenario(DRG,01dDisp,MTF_ALOS,DoD_ALOS):- 

scenarioDb(DRG,01dDisp,MTF_ALOS,DoD_ALOS),!.  %  scenario  database 


^*****:t:************************************************************************* 


If  The  DRG  has  not  been  manipulated  during  this  session,  the  current 
data  used  will  be  from  the  RCMAS  database. 

WiU  succeed  only  if  the  DRG  is  in  the  original  RCMAS  Data.  If  both 
the  above  and  tMs  predicate  fails,  then  the  scenario  will  show  that 
no  patients  have  been  treated  at  the  facility. 


*******************************************************************************^ 


scenario(DRG,01dDisp,MTF_ALOS,DoD_ALOS):- 

top_drgs(_,DRG,_,01dDisp,MTF_ALOS,DoD_ALOS),!.  %  RCMAS  database 


y******************************************************************************* 

This  section  manages  assertions  to  the  internal  database  on  the  status 
of  DRGs  currently  changed  by  the  scenario 
*******************************************************************************^ 
/*  No  Changes  */ 

changcDRGsC»_iChangeInDisp,_,_):-ChangeInDisp  =  0,!. 


changeDRGs(DRG,_,ChangeInDisp,MTF_ALOS,DoD_ALOS):-  %  Adding  If  Changed  Before 
ChangeInDisp>0, 

scenarioDb(DRG,ScenarioDisp,MTF_ALOS,DoD_ALOS),  %  scenario  database 

NewScenarioDisp=ScenarioDisp+ChangeInDisp, 

retractall(scenarioDb(DRG, 

assert(scenarioDb(DRGJ'I'ewScenarioDisp,MTF_ALOS,DoD_ALOS)),  !. 


changeDRGs(DRG,_,ChangeInDisp,MTF_ALOS,poD_ALOS):-  %  Subtract  If  Changed  Before 
ChangeInDisp<0,  7o  i.e.  subtracting  dispositions 

scenarioDb(DRG,ScenarioDisp,MTF_ALOS,DoD_ALOS),  %  scenario  database 
NewScenarioDisp=ScenarioDisp  +  ChangeInDisp, 
retractall(scenarioDb(DRG, 

assert(scenarioDb(DRG,NewScenarioDisp,MTF_ALOS,DoD_ALOS)),!. 


changeDRGs(DRG,01dDisp,ChangeInDisp,MTF_ALOS,DoD_ALOS):-  %  First  Change 
ScenarioDisp  =  OldDisp  +  ChangelnDisp^-etractalKscenarioDMDRG, 
assert(scenarioDb(DRG,ScenarioDisp,MTF_ALOS,DoD_ALOS)), 
retractall(scenarioWindowDb(DRG,_)),  %  To  Notify  If  DRG  has  Been  Changed 
asserUscenarioWindowDtKDRG, OldDisp)),!.  %  By  Scenario 
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If  the  DRG  has  been  changed  hy  the  scenario  a  blinking 
indication  is  given  to  the  summary  box  for  the  DRG. 

:1c****************************************************************************/ 


showScenarioChange(DRG):-  scenarioWindowDb(DRG,_), 
makewindow(61,238,0,"",18,29,1^3), 
writeC'  Scenario  Changes  Made"),!- 
showScenarioChange(_) 


removeScenarioWindow:-existwindow(61),removewindow(61,l),!- 

removeScenarioWindow:-! . 


/4c4c4c:(c:4c:(c:)c4c**************************************4t*:|c:tc*************************** 

Allows  one  to  extract  the  Nth  element  from  a  list 
and  return  that  element 

*****************************************************************************/ 


extractd, [Head IT], Head, T):-  !. 

extract(PICK,[Head  I  Tail], ServiceName, [Head  I  Back]):- 

PICKl  =  PICK-1,  !,  extract(PICKl,Tail,ServiceName,Back). 
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Appendix  H  (cont’d) 
SELECTION  MODULE 


code=1500 

project  "drgcolor" 
include  "glob_drg.pro" 


CLAUSES 

/♦*  mdc(MDC,LIST)  (i,o)  returns  a  list  of  all  DRGs  in  the  MDC  asked  for  ***/ 

mdc(MDC.Li3t):-MDC=l.findall(DRG.mdcl(  .  ,DRG^  ,  .  .  l.List),!. 
mdc(MDC,List):-MDC=2,findall(DRG,mdc2(_^,DRG,_,_^,J,List),!. 
mdc(MDC.List):-MDC=3.findall(DRG.mdc3(  .  ,DRG,  .  ,  .  l-Iistj!. 
mdc(  MDC  ,Liist):-MDC=4,findall(DRG,mdc4(_^,DRG,_,_,^,_), List),!. 
mdc(MDC.List);-MDC=5,findall(DRG,mdc5(__,DRG,_,_,_,J,List),!. 
mdc(MDC,List):-MDC=6,findall(DRG,mdc6(_,_,DRG,_,__,J,List),!. 
mdc(  MDC, List):-MDC=7,findall(DRG,mdc7Ci^,DRG, List),!. 
mdc(MDC.List):-MDC=8.findall(DRG.mdc8(  .  ,DRG,  ,  .  .  ).List),!. 
mdc(MDC,List):-MDC=9,findall(DRG,mdc9(_,_,DRG,  List),!. 
mdc(MDC,List):-MDC:^10,findaU(DRG,mdcl0(_,_,DRG,_,__,J,List),!. 
mdc(I^C.List);-MDC=llAidaUfDRG.mdcllf  ^  .DRG.  .  .  .  ).List).!. 
mdc(MDC,List):-MDC=12,findall(DRG,mdcl2(_,_,DRG,_,_,_,J,List),!. 
mdc(MDC,List):-MDC=13,findall(DRG,mdcl3C,_,DRG,_,_,_,J,List),!. 
mdc(MDC.List):-MDC=14Aidall(DRG.mdcl4(  ,  ,DRG,  ,  ,  ,  ),List),!. 
mdc(MDC,List):-MDC=15,findall(DRG,mdcl5(_,_,DRG,_,_,_,_),List),!. 
mdc(MDC,List):-MDC=164hidall(DRG,mdcl6(_,_,DRG,_,_,_,_),List),!. 
mdc(MDC,List);-MDC=174ndaU(DRG,mdcl7(_,^DRG,_,_,^,J,List),!. 
mdc(MDC.List):-MDC=18iindall(DRG.mdcl8(  ,  ,DRG,  ,  .  ,  ),List),!. 
mdc(MDC,List):-MDC=194ndall(DRG,mdcl9(__,DRG,_,_,_,J,List),!. 
mdc(MDC.List):-MDC=20£ndall(DRG.mdc20(  ,  .DRG.  .  .  .  ),List),!. 
mdc(  MDC,Li8t):-MDC=2 1  ,findall(DRG,mdc2 1(_,_,DRG, List), ! . 
mdc(MDC.List):-MDC=22.findall(DRG.mdc22(  ,  ,DRG.  .  ,  .  ),List),!. 
mdc(MDC,List):-MDC=234indall(DRG,mdc23(__,DRG,_,_,_,_),List),!. 
mdc(MDC,Li8t)  :-MDC=24  ,findall(DRG,mdc24(_,_,DRG,_,_,_,_),List), ! . 

Given  an  MDC  and  the  PICK,  or  order  for  a  DRG  within  the 
MDC,  this  predicate  returns  essential  information 
concerning  the  DRG. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut  ):- 
MDC  =  1J>ICK  =  DRG, 
mdcl(_.DRG,Name,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  24»ICK  +  35  =  DRG, 
mdc2C,DRG,Name,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 

MDC  =  3JPICK  <27J>ICK  +  48  =  DRG,mdc3C,DRGJ^ame,WTALOS,SSCut,LSCut),!. 
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which(PICK^DC,DRG4^ame,WT,AL0S,SSCut,LSCut):- 
MDC  =  3^ICK  <29^ICK  +  141  =  DRG, 
mdc3(_,DRG,Name,^^,AL0S,SSCut,LSCut),!. 

If  DRG  186  "Dental  and  Oral  Disorders  Except  Extractions" 
or  or  DRG  187  "Dental  Extractions  and  Restoration"  is 
selected  a  window  pops  up  to  notify  that: 
these  drgs  can  be  coded  under  two  separate  major 
Diagnostic  Categories:  MDC  3:  Ear,  Nose  and  Throat,  or 
MDC  6:  Digestive  system 

which(PICK,MDC,DRGJ^ame,WT,ALOS,SSCut,LSCut):- 
MDC  =  3, PICK  <31, PICK  +  157  =  DRG, 
mdc3(_, DRG, Name, WT,ALOS,SSCut,LSCut), 
makewindow(60,110,238,"NOTICE",6,20,16,40), 
file_str("drgl86-7.txt",TEXT),write(T?EXT),pause,removewindow(60,l),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  4,PICK  +  74  =  DRG, 
mdc4(_,DRG,Name,WT,ALOS,SSCut,lfiCut),!. 

which(PICK,MDC,DRGJTame,WT,ALOS,SSCut,LSCut):- 
MDC  =  5,PICK  +  102  =  DRG, 
mdc5C,DRG,Name,WT,ALOS,SSCut,LSCut),!. 

which(PICK34DC,DRGJ^^ame,WT,ALOS,SSCut,LSCut):- 
MDC  =  6,PICK  +  145  =  DRG, 
mdc6(_,DRG,Name,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  7,PICK  +  190  =  DRG, 
mdc7(_,DRG,Name,WT,ALOS,SSCut,LSCut),!. 

which(PICKJMDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  8,PICK  <  49,PICK  +  208  =  DRG, 
mdc8(_,DRG4Srame,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  8,PICK  =  49, PICK  +  422  =  DRG, 
mdc8(_,DRG,Name,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC  ,DRG  ame,WT,ALOS,SSCut,LSCut):- 
MDC  =  9J>ICK  +  256  =  DRG, 
mdc9(_,DRG,N£ime,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  10,PICK  +  284  =  DRG, 
mdclO(_,DRGJ^ame,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  11,PICK  +  301  =  DRG, 
mdcll(_,DRG,Name,WT,ALOS,SSCut,LSCut),!. 
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which(PICK^DC,DRGJ^ame,WT^OS,SSCut,LSCut):- 
MDC  =  12, PICK  +  333  =  DRG, 
mdcl2(_,DRG,Naine,WTALOS,SSCut,LSCut),!. 

which(PICK>IDC,DRG,Name,WTALOS,SSCut,LSCut):- 
MDC  =  13, PICK  +  352  =  DRG, 
mdcl3C>DRG,Naine,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  14,PICK  +  369  =  DRG, 
mdcl4(_,DRG,Name,WTALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  15,PICK  +  384  =  DRG, 
mdcl5C,DRG,Naine,WTALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  16,PICK  +  391  =  DRG, 
mdcl6(_,DRG,Name,WT,AL0S,SSCut,LSCut),!. 

which(PICK,MDC,DRGJ^ame,WT,ALOS,SSCut,LSCut):- 
MDC  =  17,PICK  <  16,PICK  +  399  =  DRG, 
mdcl  7L>DRG,N  aine,WT,ALOS,SSCut,LSCut), ! . 

which(PICK>IDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  17,PICK  =  16,PICK  +  457  >=  DRG, 
mdcl7(_,DRG,Naine,WT,AL0S,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WTALOS,SSCut,LSCut):- 
MDC  =  18,PICK  +  414  =  DRG, 
mdcl8(_,DRG,Name,WTAL0S,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  19,PICK  +  423  =  DRG, 
mdcl9(_,DRGJ^ame,WT,AL0S,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  20,PICK  +  432  =  DRG, 
mdc20(_,DRG,Name,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  21,PICK  +  438  =  DRG, 
mdc21(_,DRG,Nanie,WT,ALOS,SSCut,LSCut),!. 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  22,PICK  <  6,PICK  +  455  «  DRG, 
mdc22(_,DRGJ^aine,WT,ALOS,SSCut,LSCut),!. 

whidi(PICK,MDC,DRG,Name,WTALOS,SSCut,LSCut):- 
MDC  =  22,PICK  =  6,PICK  +  466  =  DRG, 
mdc22(_,DRG,Name,WT,ALOS,SSCut,LSCut),!. 
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which(PICK,MDC,BRG;Slame,WT,ALOS,SSCut,LSCut):- 
MDC  =  23, PICK  +  460  =  DRG, 
mdc23L,DRG,Name,WT,ALOS,SSCut,LSCut),!. 

^i)::^**^i*^i^i*****^iSti^i**iti*****:tf****************************************************** 

If  DRG  472  "Extensive  Bums  With  OR  Procedure"  is  selected 
a  window  pops  up  stating:  This  DRG  Can  Be  Coded  Under  Two 
Separate  Major  Diagnostic  Categories:  MDC  22  "Bums"  or 
MDC  24  "DRGs  Associated  With  All  MDCs". 

which(PICK,MDC,DRG,Name,WT,ALOS,SSCut,LSCut):- 
MDC  =  24, PICK  =  5,PICK  +  467  =  DRG, 
mdc22(_,DRG,Name,WT,ALOS,SSCut,LSCut), 
makewindow(60,110,238,"NOTICE",6,20,12,40), 
file_str("drg472.txt",TEXT),write(TEXT),pause,removewindow(60, 1 ), ! . 

which(PICK,MDC,DRGJ^ame,WT,ALOS,SSCut,LSCut):- 
MDC  =  24,PICK  <  7,PICK  +  467  =  DRG, 
mdc24(_,DRG,Name,WT,ALOS,SSCut,LSCut),!. 

^*,tt***************************************************************************** 

Provides  essential  information  for  CMI  module  scenario 
for  determining  when  a  hospital  has  changed  peer  groups 
and  what  the  effect  on  RAG  reimbursement  will  be 


RAG  Change 

BedSize 

RCMI 

Peer, 

Up 

Down 

Lower 

upper 

lower 

upper 

*/ 

peer<"CHl", 

61.06, 

0, 

1, 

29, 

0, 

0.7499 

). 

peer<"CH2", 

0, 

61.06, 

1. 

29, 

0.75, 

10 

). 

peei<"CH3", 

30.35, 

0, 

30, 

49, 

0, 

0.7999 

). 

peer("CH4", 

0, 

30.35, 

30, 

49, 

0.8, 

10 

). 

peer<"CH5", 

-13.95, 

0, 

50, 

99, 

0, 

0.8499 

). 

peer("CH6", 

0, 

13.95, 

50, 

99, 

0.85, 

10 

). 

peer<"CH7", 

43.64, 

0, 

100, 

1000, 

0, 

0.8999 

). 

peed  "CHS", 

0, 

43.64, 

100, 

1000, 

0.9, 

10 

). 

peer<"MCl", 

28.17, 

0, 

0, 

1000, 

0, 

1.1999 

). 

peer<"MC2", 

23.73, 

28.17, 

0, 

1000, 

1.2, 

1.4999 

). 

peer("MC3", 

0, 

23.73, 

0, 

1000, 

1.5, 

10 

). 

Given  a  DRG,  this  predicate  returns  the  MDC  and  order  of 
the  DRG  or  "PICK"  within  the  MDC. 


^l^l^l^t^t*************************************************************************/ 


listem(ChoiceJ*ICK,MDC):-  Choice  >  473,  %%  LARGEST  DRG  IS  473 
makewindow(33,l  10, 1 10,"Notice",15,24,5,31),nl, 
writeC  DRGs  are  Numbered  1  -  473"), 


pause, 

removewindow(33 , 1  ),remove  window(23, 1  ),PICK=500,MDC =0 , ! . 


listem(Choice,PICK,MDC):-  Choice  <  36,PICK=Choice,MDC=l,!. 
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listem(Choice,PICK,MDC):- 
listem(  Choice  JPICK,MDC):- 
listem(ChoiceJ*ICK,MDC);- 
listem(Choice^ICK,MDC);- 
listem(Choice^ICK,MDC):- 
listem(Choice,PICK,MDC):- 
listem(ChoiceJ*ICK,MDC):- 
listem(Choice,PICK,MDC):- 
listem(Choice,PICK,MDC):- 
listem(Choice,PICK,MDC):- 
listem(  Choice, PICKjMDCir- 
listemCChoicejPICK.MDC):- 
listem(ChoiceJ’ICK,MDC):- 
listem(Choice,PICK,MDC);- 
listem(ChoiceJ*ICK,MDC):- 
listem(Choice,PICK,MDC):- 
listem(ChoiceJPICK,MDC):- 
listem(ChoiceJ*ICK,MDC):- 
listem(Choice,PICK,MDC):- 
listem(Choice4’ICK,MDC):- 
listem(Choice,PICK,MDC);- 
listem(ChoiceJ*ICK,MDC):- 
listem(Choice,PICK,MDC);- 
Ustem(Choice,PICK,MDC):- 
listem(Choice,PICK,MDC):- 
listem(ChoiceJ*ICK,MDC):- 
listem(Choice,PICK,MDC);- 
listem(Choice,PICK,MDC):- 
listem(Choice,PICK,MDC):- 
listem(Choice,PICK,MDC):- 
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Choice  <  49,PICK=Choice-35,MDC=2,!. 
Choice  <  75,PICK=Choice-48,MDC=3,!. 
Choice  =  168,PICK=Choice-141,MDC  = 
Choice  =  169,PICK=Choice-141,MDC  = 
Choice  =  186,PICK=Choice-157,MDC  = 
Choice  =  187,PICK=Choice-157,MDC  = 
Choice  <  103,PICK=Choice-74,MDC=4,! 
Choice  <  146,PICK=Choice-102,MDC=5 
Choice  <  191,PICK=Choice-145,MDC=6 
Choice  <  209,PICK=Choice-190,MDC=7 
Choice  <  257,PICK=Choice-208,MDC=fi 
Choice  =  471,PICK=Choice-422,MDC=g 
Choice  <  285,PICK=Choice-256,MDC=S 
Choice  <  302,PICK=Choice-284,MDC=l 
Choice  <  334,PICK=Choice-301,MDC=] 
Choice  <  353,PICK=Choice-333,MDC=l 
Choice  <  370,PICK=Choice-352,MDC=l 
Choice  <  385,PICK=Choice-369,MDC=] 
Choice  <  392,PICK=Choice-384,MDC=l 
Choice  <  400,PICK=Choice-391,MDC=] 
Choice  <  415,PICK=Choice-399,MDC=] 
Choice  =  473,PICK=Choice-457,MDC=] 
Choice  <  424,PICK=Choice-414,MDC=] 
Choice  <  433,PICK=Choice-423,MDC=] 
Choice  <  439,PICK=Choice-432,MDC=i 
Choice  <  456,PICK=Choice-438,MDC=5 
Choice  <  461,PICK=Choice-455,MDC=5 
Choice  =  472,PICK=Choice-466,MDC=i 
Choice  <  468,PICK=Choice-460,MDC=5 
Choice  <  474,PICK=Choice-467,MDC=5 
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RCMAS  IMPORTING  MODULE 


project  "drgcolor" 
include  "glob_drg.pro" 


DOMAINS 

TEXT, REST1,REST2,REST4, Input  =  string 
TOTAL,DRGj)ISP, Count  =  integer 
MTF_ALOS,DOD_ALOS  =  real 
Select  =  char 


PREDICATES 

rcmas(integer) 

rcmas_one 

readtext(  Count, TEXT) 

readtexttop 

readfile 

writefile 

exist(Select) 

del_comma(Input,DISP) 

strip_drg(TEXT,DRG,RESTl) 

strip_name(RESTl,DRG_NAME,REST2) 

strip_disp(REST2,DISP,REST4) 

strip_alos(REST4,MTF_ALOST)OD_ALOS) 

change_disp(DISP  ,TOTAL) 

del_rcmas 

printer(SELECTION) 

rcmasHelp(SELECTION) 

CLAUSES 

rcmas_top:-  repeat,arrowkey_statusline, 
longmenu(ll,21,4,lll,110, 

[  "  Import  all  Facility  DRGs  ", 

"  Cancel  Request  ", 

"  Information  On  Importing  RCMAS  DATA  ", 

"  View  RCMAS  File  of  DRGs  "], 

"RCMAS  Import  Module",!, CHOICE),  rcmas(CHOICE), 
clearwindow,removewindow(  21,1), 
removewindow(  60, 1 ), ! . 

rcmas(l):-  %%  NO  FILE  EXISTS  TO  IMPORT 

not(existfile("rmcas.out")),not(existfile{"drg.tab")), 
make  window(63,110,110,"", 10,26,5,28), 
write("\nNo  file  exists  to  import"), 
make  window(77,31,0, "",24,0, 1,30), 

writeC  Press  Any  Key  To  Continue  "), 

readchar(_),remove  window(63 , 1  ),remove  window(  77, 1 ), ! . 
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rcmas(l):-  %%  IMORT  ALL  FACILITY  DRGs  AGAIN 
existfileC'rcmas.out"), 

I' 1  AJl  Tl  n  rt  w 

makewindo^21,113,0,"",24,0,l,80), 

writeC  Press  ’Y’  for  Yes  or  ’N’  For  No  You  Do  Not  Wish  To  Delete  The  file"), 
makewindow(61,110,110,"",10,15,7,50), 
writeC  You  have  already  processed  your  data\n\n"), 
write("  Do  you  wish  to  delete  the  file  and  reprocess?\n\n"), 
write("  (Y/N)"),repeat,readchar<Select), 

exist(Select),!. 


rcmas(l):-  %%  IMPORT  ALL  FACILITY  DRGs 
rcmas_one,!. 

rcmas(2):-!.  %%  CANCEL  REQUEST 


^*if*ilf^:it************************************************************************ 


RCMAS  Instruction  Section, 
one  can  view  and/or  print  the  instructions 

Hfti********************************.********************************************/ 


rcmas(3):-makewindow(22,113,0,"",24,0,l,80), 

writeC  Use  Airowkeys,  PgUp,  or  PgDn  Press  <Esc>  When  Done"), 

makewindow(12,110,110,"  RCMAS  Help  File  ”,2,5,18,70), 
file_strCrcmas.txt"  ,Text),display(Text), 
longmenu(9,25,2,112,112, 

["  Print  These  Instniction  ", 

"  Return  To  Main  Menu  "],"",2,CHOICE), 
rcmasHelp(CHOICE),removewindow(i2,l),removewindow(22,l),!. 


rcmas(4):-  existfile("drg.tab"),makewindow(22,113,0,"",24,0,l,80), 

writeC  Use  Arrowkeys,  PgUp,  or  PgDn  Press  <Esc>  When  Done"), 

makewindow(2,31,145,"",0,0,24,80),fiie_str("drg.tab",Text),display(Text), 

removewindow(2,l),removewindow(22,l),!. 


rcmas(4):-existfile{"\\rcmas\\drg.tab"),makewindow(22,113,0,"",24,0,l,80), 

writeC  Use  Arrowkeys,  PgUp,  or  PgDn  Press  <Esc>  When  Done"), 

makewindow(2,31,145,"",0,0,24,80),file_strCdrg.tab",Text),display(Text), 

remove  window(2 , 1  ),removewindow(22, 1 ), ! . 


rcmas(4):-  makewindow(60,lll,238,"NOTICE",10,13,4,54), 

writeC  No  DRG.TAB  file  was  found  "),nl, 

writeC  Strike  Any  Key  and  Reselect  Importing  Information  "),pause,!. 

rcmasHelp(l):-  makewindow(23,110,110,"",6,22,9,35), 
file_strCprinter.txt", TEXT),write(TEXT), 
longmenu(  16,27,2, lil, 110, 

["  Continue  ", 

"  Cancel  Print  Request  "],"",  l,CHOICE),  printer(CHOICE), 
removewindow(23, 1 ), !. 
rcmasHelp(2);-!. 

printerd):-  trap(system("rcmas.bat"),_,true),!. 
printer(2):-!. 
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ReadKey  section  for  reading  keyboard  input  on 
whether  to  reprocess  RCMAS  files 


exist(Select):-Select=’Y’,removewindow, 

closefiletrcmas  input), re tractalK top  drgsC . )). 

rcmas_one,  removewindow(22,l),!. 
exist(Select);-Select=y,removewindow, 

closefiletrcmas  inputl.retractalKtop  drgs( . )). 

rcmas_one,  removewindow(22,l)J- 
exist(Select):-Select=’N’,removewindow,!. 
exist(Select):-Select=’n’,removewindow,!. 
exist(_):-  beep, fail,!. 


Controls  import  of  RCMAS  Data 

rcmas_one:-  makewindow(2,31,145,"",0,0,24,80), 
patience, 

retract(total_dispC)), 

assert(total_disp(0)), 

shiftwindow(2),cursor(8,65),attribute(30). 


writeC'Total"), 

cursor(l  3,65  ),write(  "Total"  ),attribute(3 1 ), 
makewindow(  60,110,110,"",!, 14,3,34), 
writeC  Importing  The  Following  DRGs:  "), 

makewindow(61, 110, 110, "DRGs  Dispositions”,5,5,19,50), 

makewindow(62,110,110,"Number  of  DRGs",10,60,3,18), 

makewindow(63, 110,110,"  Dispositions  ",15,60,3,18), 

readfile, 

writefile. 


readtexttop.retractalKtop  drgs( .  ,  )), 

readtext(0,"DUMMY"), 

clo8efile(rcmas_input), 

closefile(output), 

retract!  top_drgs(_,0,_, _,_,_)), 

shiftwindow(60),nl,nl,attribute(238), 

writeC  Writing  DRGs  to  Disk  "), 

del_rcmas, 

save("rcmas.out",top_drgs), 
removewindow(22, 1 ), 
removewindow(63, 1 ), 
removewindow(62, 1 ), 
removewindow(6 1 , 1 ), 
remove  window(60, 1 ), 
remove  window(2 , 1 ),! . 


del_rcmas:-  existfile("rcmas.out"),deletefile("rcmas.out"),!. 
del_rcmas:-!. 


readfile:-  openread(rcmas_input,"drg.tab"),readdevice(rcmas_input),!. 
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writefile:-  openwrite(output,"rcmas.out"),  writedevice(output),!. 


Strips  off  the  top  of  the  RCMAS  output  file  up  to  the  first 

^i:^fif:*:ti************************************m*************************************f 


readtexttop:-repeat,readln(Text),  frontchar(Text,Char^,Char  = 


Recursion  loop  for  reading  each  line  of  text  and 
asserting  to  the  internal  database  the  appropriate 
information.  Also  writes  the  information  to  the 
screen  for  viewing. 


readtext(_.TEXT):-str_len(TEXT,LENGTH),LENGTH<l. 
readtext( Count, _):-  readln(TEXT),Countl=Count+l, 
strip_drg(TEXT,DRG,RESTl), 
strip_name(RESTl,DRG_NAj^,REST3), 
strip_disp(REST3,DISP,REST4), 
strip_alos(REST4,MTF_ALOS,DOD_ALOS), 
change_disp(DISP, TOTAL), 
writedevic^  screen), 

gotowindow(61),nl,write("  ’',DRG_NAME), 
gotowindow(62),nl, writer  ",Coijnt), 

gotowindow(63),nl,wTite("  ",TOTAL), 

writedevice(output), 

assertz(top_drgs(Countl,DRG,DRG_NAME,DISP,MTF_ALOS,DOD_ALOS)), 
readtext(Countl  ,TEXT). 


Strips  off  the  DRG  from  the  line  of  text 

***!(<***********************#***********i(c********************************:(t*****:(c^ 


strip_drg(TEXT,DRG,RESTl):-  fi-ontstr(3,TEXT,STR_DRG,RESTl), 
str_int(STR_DRG,DRG),!. 
strip_drg(_,DRG3ESTl):-DRG=0,RESTl="",!. 


Strips  off  the  name  of  the  DRG  fi^)m  the  line  of  text 


strip_name<RESTl  J)RG_NAME,REST2);-fix)ntstr(25,RESTl,NAMEl,REST2), 
fnjntstr(10,REST2,REST3,J, 

concat(NAMEl,REST3,NAME2),  concat(NAME2,"  ",DRG_NAME),!. 
strip_name(_,DRG_NAME,REST2):-  DRG_NAME="",REST2="",!. 


Strips  off  the  number  of  dispositions  from  the  line  of  text 

^^iil*^^^t^*i^i^lm*********************************************************************/ 


strip_disp(REST2,DISP,DISP4):-  frontsti<10,REST2,INPUT,DISP4), 
del_comma(INPUT,DISP),!. 
strip_disp(_J)ISP,DISP4):-DISP=0,DISP4=''",!. 
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^*******************************************^^1**********:^!*********************** 
Strips  off  the  average  length  of  stay  from  the  line  of  text 

*****************^fif**^i*******!ti*****^i*ilt*^i^^iiiimif^lL:H)im**i^**************************/ 

strip_alos(REST4,MTF^ALOS,DOD_ALOS);- 


/*****  strip  off  unneeded  spaces  **♦♦**/ 
frontstr(16,REST4,_, RESTS), 


/*****  strip  off  LOS  Actual  **********/ 

frontstr(5, RESTS, STR_MTF_ALOS,REST6),str_real(STR_MTF_ALOS,MTF_ALOS), 

/*****  strip  off  LOS  Expected,  i.e.  DoD  LOS  *******/ 
frontstr(10,REST6,STR_DOD_ALOS,_),str_real(STR_DOD_ALOS,DOD_ALOS),!. 


strip_alos(_,MTF_ALOS,DOD_ALOS):-  MTF_ALOS=0,DOD_ALOS=0,!. 

Asserts  to  an  internal  database  the  total  dispositions 

change_disp{DISP,TOTAL);-total_disp(OLD), TOTAL  =  OLD  +  DISP, 
retract(total_disp(_)),assert(total_disp(TOTAL)),!. 

^***:ti***ti:^ilfif^t1cif:t‘*************************************************************** 

Unfortunately,  ROMAS  output  places  commas  within  integers,  this  section 
strips  the  comma  out  and  returns  an  integer  as  Output  from  String  Input 

DOMAINS 


charlist  =  char* 


PREDICATES 

string_chlist(string,  charlist) 

delete(char,charlist,charlist) 

group(charlist,string,string) 


CLAUSES 
string_chlist("",  []). 

string_chlist(S,  [HIT])  frontchar(S,  H,  Si),  string_chlist(Sl,  T). 

delete(Element,[Element  I  Tail], Tail). 
delete(Element,[Head  I  Tail],[Head  I  List])  if!, 
delete(Element,Tail,List). 

group([],NewNew)  if!. 
group([H  I  T],String,New)  if  str_char(HS,H), 
concat(String,HS,Temp), 
concat(Temp,"",Str),!, 
group(T,Strd^ew). 

del_comma(Input,DISP):-str_int(Input,DISP),!. 


Appendix  H  (cont’d) 

del_comma(Input,DISP):-  strmg_chlist(Input^),delete(’,’^X,Y), 
group(Y,"",Z),  str_int(Z,DISP),!. 
del_coimna(_,DISP):-  DISP  =  0,!. 
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Appendix  H  (cont’d) 

GLOBAL  DEFINITIONS  MODULE 

GLOBAL  DATABASE  -  (nirrent_ho8pital 
current_hospital(integer, string, symbol, real,integer, real) 

GLOBAL  DATABASE  -  mdclist 
mdclist(integer,string) 

GLOBAL  DATABASE  -  mdcl 
mdcl(integer,integer,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdc2 
mdc2(integer,integer,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdc3 
mdc3(integer,integer,string,real,real, real, real) 

GLOBAL  DATABASE  -  mdc4 
mdc4(integer,integ3r,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdc5 
mdc5(integer,integer,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdc6 
mdc6(integer,integer,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdc7 
mdc7(integer,integer,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdc8 
mdc8(integer,integer,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdc9 
mdc9(integer,integer,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdclO 
mdclO(integer  integer  ,string,real,real,real, real) 

GLOBAL  DATABASE  -  mdcll 
mdcll(integer4nteger,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdcl2 
mdcl2(integer4nteger,string4'eal, real  ,real, real) 

GLOBAL  DATABASE  -  mdcl3 
mdcl3(integer4nteger , string, real,real4'eal,real) 

GLOBAL  DATABASE  -  mdcl4 
mdcl4(integer  integer, string, real  4'eal4'eal,real) 

GLOBAL  DATABASE  -  mdcl5 
mdcl5(integer  integer  ,string,real,real,real,real) 
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GLOBAL  DATABASE  -  mdcl6 
mdcl6(integer4nteger,strmg^eal^eal^eal,real) 

GLOBAL  DATABASE  -  mdcl7 
mdclTCinteger^nteger, string, real^eal  .real, real) 

GLOBAL  DATABASE  -  mdclS 
mdcl8(integer  integer  ,string,real,real,real, real) 

GLOBAL  DATABASE  -  mdcl9 
mdcl9(integerdnteger, string, real,real,real, real) 

GLOBAL  DATABASE  -  mdc20 
mdc20(mteger  integer  ,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdc21 
mdc21(integer4nteger,string,real,real,real,real) 

GLOBAL  DATABASE  -  mdc22 

mdc22(  integer  integer  ,string,real,real4‘eal,real) 

GLOBAL  DATABASE  -  mdc23 
mdc23(integer  dnteger  ,string,real  ,real  ,real,real) 

GLOBAL  DAT^ASE  -  mdc24 
mdc24(integer  integer  ,string,real  ,real  ,real,real) 

GLOBAL  DATABASE  -  top_drgs 
top_drgs(integer,integer,string,integer,real4’eal) 

GLOBAL  DATABASE  -  all_hospitals 
mtflinteger,string,symbol,real,integer,real) 

GLOBAL  DATABASE 

old(integer,real,real,real,real,real) 

new(integer,real  ,real , real  ,real  .real ) 

last(integer,real,real,real,real,real) 

cliange(integer  .real  .real  ,real,real,real) 

monejKreal) 

originalMoney(  real ) 

total_disp(integer) 

pay_for_mccu(real) 

scenarioDb(integer,integer,real,real) 

scenarioWindowDb(integer,integer) 

GLOBAL  DOMAINS 

WATTR,FATTR,  ATTR,  LOS,  SSCut,  LSCut,  Num,  ROW,  COL,  LEN,SCR,FR  =  INTEGER 
MDC4>ICK,STARTCHOICE,SELECTIONJ>OPF,POPW,MAINF,MAINW  =  integer 
MAXH.INTEGERLIST  =  INTEGER* 

Name,LIST,STRINGLIST  =  STRING* 

ST.LT.WT  =  REAL 

file=input;outputprcmas_input;this_hospital 
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Hosp,DRG_NAME, HEADER  =  string 

KEY  =  cr;  esc;  break;  tab;  btab;  del;  bdel;  ctrlbdel;  ins; 

end  ;  home  ;  fkey(INTEGER)  ;  up  ;  down  ;  left  ;  right  ; 
ctrlleft;  ctrlright;  ctrlend;  ctrlhome;  pgup;  pgdn; 
ctrlpgup;  ctrlpgdn;  ques;  char(CHAR)  ;  otherspec 

GLOBAL  PREDICATES 
display_logo 
changeCaseMix 
changeCaseMix(integer)-(i) 
delay(real)-(i),(o) 

nondeterm  repeat  /*  Provides  a  repeat  loop  for  main  menu  */ 

atTowkey_statusline 

exp_window(integer)-(i),(o) 

data_read(real)-(i),(o) 

ask_cmi(MDC,PICK)-(i,i) 

define 

patience  /*  Provides  status  window  for  loading  data*/ 

longmenu(ROW,COL^teger,WATTR^ATrR,STRINGLIST, HE  ADER,STARTCHOICE, SELECTION) 
-(i,i,i,i,i,i,iA.o) 

which(integer,integer,integer,string,real,real,real,real)- 
(i,i, 0,0,0, 0,0,0), 
nondeterm  rcmas_top 
readkeydCEY)  -  (o) 

readkeyl(KEY,CHAR,INTEGER)  -  (o,i,i) 

listem(integer,integer,integer)  -  (i,o,o) 

calculate(real,real,real,real)  -  (o,o,o,o) 

data(mteger)-<i) 

utihties_module 

cxirrent 

mdc(mteger,stringlist)-(i,o) 

peer(symbol,real,real,integer,integer,real,realKi,o,o,o,o,o,o) 

length(real  ,real)-(i  ,0) 

iwu_length(real,real)-(i,o) 

money_length(real,real)-{i,o) 

maxlen(STRINGLIST,COL,COL)-(i,i,o)  /*  The  length  of  the  longest  string  */ 
pause 

data_l_status 

data_2_status 

listlen(stringlist,integer)  -  (i,o) 
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Prolog  Software  Program  (Color) 


A  Complete  Program  Can  Be  Obtained 
By  Sending  Your  Name,  Address  and 
A  5  1/4"  Diskette  To: 


Commander 
U.S.  Army  MEDDAC 
HSXT'AR  (Attn:  MAJ  Howard  C.  May) 
Fort  Ord,  CA,  93941-5800 
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Prolog  Software  Pro£ 


f  La  plot 


A  Complete  Program  Can  Be  Obtained 
By  Sending  Your  Name,  Address  and 
A  3  1/2”  Diskette  To: 

Commander 
U.S.  Army  MEDDAC 
HSXT-AR  (Attn:  MAJ  Howard  C.  May) 
Fort  Ord,  CA,  93941-5800 
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